Patch for userdefined escape subroutines in H::T

Damien Clark <[email protected]> Wed, 14 May 2008 12:48:23 +1000
Newsgroups gmane.comp.lang.perl.modules.html-template
Message-ID <C4509017.90DA%[email protected]>
G¹day Sam & H::T Developers,

Let me start by saying thank-you for your work on HTML::Template.  Its a
module I use very frequently when developing web apps in Perl.  In fact,
more recently I have been using it for more than web apps, including mail
merges and just now parameterising SQL queries.  This is what I would like
to discuss with you all. :)

My name is Damien and I am currently looking at writing a perl module that
is derived (via inheritance) from HTML::Template that is specifically
designed for parameterising SQL.  My rationale for doing this I¹ll leave to
the end of the email.  If you are interested and have the time, please have
a read and tell me what you think.  To achieve this goal, it would be most
helpful to add some simple functionality to HTML::Template.  I have written
this code and attached it to this email as a patch for review and hope that
it may be included into the main HTML::Template distribution.  My rationale
for this change follows.

HTML::Template allows certain syntax to be ³escaped² using the escape
attribute in <tmpl_var> tags, and also the default_escape option to new().
This syntax escaping is hardcoded into the module and limited to HTML, JS,
and URL¹s as I understand.  I would like to extend HTML::Template to allow
the user to implement their own arbitrary escape functionality.  Doing so
would provide greater extensibility of HTML::Template into areas beyond its
traditional web roots.  Yes, including SQL. :)  It would also help to
address simple one-off problems, such as the one encounted by Alex Teslik or
Matt Taylor as per previous threads found in the archives:

http://sourceforge.net/mailarchive/message.php?msg_name=20080320022702.M3567
1%40acatysmoof.com

http://sourceforge.net/mailarchive/message.php?msg_id=1175524797.11485.1.cam
el%40deb-matt.zipper.azi (mind any url wrapping).

I am proposing the following changes to the HTML::Template API and template
format:

. Extend the syntax for <tmpl_var escape=(JS,HTML,URL,NONE,1,0)> to include
user provided attribute values.  Examples are probably more clear:
<tmpl_var name=¹bla¹ escape=php>  or in my case <tmpl_var name=¹bla2¹
escape=sql>.  

. The constructor to take the option ³escape² with the value being a
hashref.  The keys will be the escape names gives in the templates (e.g. php
or sql) and the value a reference to a subroutine that is provided by the
user to escape any special meanings to the syntax used in that context.
This will be implemented in the same way as the filter option that currently
exists in HTML::Template.  The template variable value will be passed to the
subroutine as a scalarref as is done for filters.

Once again, an example (yes a little contrived):

-----------------------
my $esc = sub 
{ 
  my $value = shift ;
  $$value =~ s/\\/\\\\/g ;
  $$value =~ s/%/\\%/g ;
  $$value =~ s/_/\\_/g ;
  $$value =~ s/'/\\'/g; #etc
} ;

my $t = HTML::Template->new(filename => 'query.sqlt', escape => {sql =>
$esc}) ;

$t->param(surname => ³O'Loughlin²) ;

--query.sqlt--
select interest,term from loan
where client_surname like '<tmpl_var name=²surname² escape=²sql²>' escape
'\\' ;
----------------------------

So Sam, do you have time to include my work into HTML::Template, and do you
agree with my approach and rationale for this change?  What do you reckon?
:)

My rationale for creating this perl module is as follows.

I know there are other perl solutions to this, but they are mostly based
around writing perl to generate SQL, rather than parameterising queries.
Often they attempt to abstract the SQL syntax into an API.  These approaches
while catering to most likelys are still very constraining in terms of the
versatility of the SQL.  Those that do parameterise queries have unfamiliar
syntax or are limited in how they deal with parts of the query being missing
and other problems.  HTML::Template is very well known in the web
programming space in Perl, and SQL and web go hand in hand.  So I am
thinking it is a shorter leap for developers to use HTML::Template syntax in
their queries and then you can leverage more easily some of the more
colourful tricks in SQL to get your data, without requiring Perl to crunch
it into the required form.  Plus, I also plan to add some syntactic sugar in
my own module that enhances HTML::Template specifically for writing SQL.  To
achieve this, I need to be able to do arbitrary escaping of user supplied
values.

I tried to make this email as short as possible, as I previously said, I¹m
sure you are all very busy.  If you made it this far, my sincere thanks. :)

Regards,
Damien Clark.

-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft 
Defy all challenges. Microsoft(R) Visual Studio 2008. 
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/

_______________________________________________
Html-template-users mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/html-template-users
HTML-Template-escape.patch (application/octet-stream, 23.1 KB)
Index: t/01-bad-args.t
===================================================================
--- t/01-bad-args.t	(revision 327)
+++ t/01-bad-args.t	(working copy)
@@ -44,6 +44,49 @@
 qr/\Qcalled with odd number of option parameters - should be of the form option => value/,
 'new() called with option with no value');
 
+eval{$tmpl = HTML::Template->new(
+                                 filename => 'simple.tmpl',
+                                 path => 'templates',
+                                 escape => ["sql"]
+                                 )};
+like($@,
+qr/\Qcalled with escape option, but did not provide a hashref!/,
+'new() called with escape, but did not provide hashref');
+
+eval{$tmpl = HTML::Template->new(
+                                 filename => 'simple.tmpl',
+                                 path => 'templates',
+                                 default_escape => 'bla'
+)} ;
+like($@,
+qr/\QValid values are HTML, URL, JS or values with matching entries with the escape option./,
+'new() called with invalid default_escape option');
+
+eval{$tmpl = HTML::Template->new(
+                                 filename => 'simple.tmpl',
+                                 path => 'templates',
+                                 default_escape => 'bla',
+                                 escape => {sql => sub{}}
+)} ;
+like($@,
+qr/\QDoes not match HTML, URL, JS or any of the values provided to the escape option -/,
+'new() called with invalid default_escape option that also doesn\'t match any values provided by escape option');
+
+eval{$tmpl = HTML::Template->new(
+                                 filename => 'simple.tmpl',
+                                 path => 'templates',
+                                 default_escape => 'sql',
+                                 escape => {sql => 'sub bla'}
+)} ;
+like($@,
+qr/\Qhashref provided to escape option does not provide references to subroutines as the values./,
+'new() called with escape option, where hashref values are not references to subroutines');
+
+
+
+
+
+
 =head1 NAME
 
 t/01-bad-args.t
Index: t/12-userdefined-escape.t
===================================================================
--- t/12-userdefined-escape.t	(revision 0)
+++ t/12-userdefined-escape.t	(revision 0)
@@ -0,0 +1,120 @@
+use Test::More tests => 76;
+#use Test::More qw/no_plan/;
+use HTML::Template;
+
+use strict;
+
+my $esc = sub
+{
+    my $text_ref = shift;
+    $$text_ref =~ s/\\/\\\\/g ;
+    $$text_ref =~ s/'/\\'/g ;
+    $$text_ref =~ s/\?/\\\?/g ;
+    $$text_ref =~ s/%/\\%/g ;
+   };
+
+while( <DATA> )
+{
+    chomp;
+    next if /^$/;
+    next if /^#/;
+    my($text,$given,$wanted) = split /\|/;
+    my $template = HTML::Template->new(
+                                       scalarref => \$text,
+                                       default_escape => 'sql',
+                                       escape => {'sql' => $esc});
+    $template->param(foo => $given);
+    my $output = $template->output;
+    is($output , $wanted , $text);
+}
+
+# use pipe as the seperator between fields.
+# the TMPL_VAR name should always be 'foo'
+# fields: TMPL_VAR|given string|escaped string
+
+__DATA__
+# use default escaping
+<TMPL_VAR foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR name=foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR name='foo'>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR NAME="foo">|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR name=foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR NAME=foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR name='foo' -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR NAME="foo" -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+
+# use userdefined escaping
+<TMPL_VAR foo ESCAPE=sql>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR ESCAPE=sql foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR ESCAPE="sql" foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR foo ESCAPE="sql">|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR NAME="foo" ESCAPE="sql">|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR ESCAPE="sql" NAME="foo">|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR ESCAPE='sql' foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR foo ESCAPE='sql'>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR NAME='foo' ESCAPE='sql'>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<TMPL_VAR ESCAPE='sql' NAME='foo'>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR foo ESCAPE=sql -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR ESCAPE=sql foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR foo ESCAPE=sql -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR ESCAPE="sql" foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR foo ESCAPE="sql" -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR NAME="foo" ESCAPE="sql" -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR ESCAPE="sql" NAME="foo" -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR ESCAPE='sql' foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR foo ESCAPE='sql' -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR NAME='foo' ESCAPE='sql' -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR ESCAPE='sql' NAME='foo' -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+
+# no escaping
+<TMPL_VAR foo ESCAPE=0>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR ESCAPE=0 foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR foo ESCAPE=0>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR ESCAPE="0" foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR foo ESCAPE="0">|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR NAME="foo" ESCAPE="0">|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR ESCAPE="0" NAME="foo">|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR ESCAPE='0' foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR foo ESCAPE='0'>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR NAME='foo' ESCAPE='0'>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR ESCAPE='0' NAME='foo'>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR foo ESCAPE=0 -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR ESCAPE=0 foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR foo ESCAPE=0 -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR ESCAPE="0" foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR foo ESCAPE="0" -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR NAME="foo" ESCAPE="0" -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR ESCAPE="0" NAME="foo" -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR ESCAPE='0' foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR foo ESCAPE='0' -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR NAME='foo' ESCAPE='0' -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR ESCAPE='0' NAME='foo' -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+
+# no escaping
+<TMPL_VAR foo ESCAPE=NONE>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR ESCAPE=NONE foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR foo ESCAPE=NONE>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR ESCAPE="NONE" foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR foo ESCAPE="NONE">|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR NAME="foo" ESCAPE="NONE">|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR ESCAPE="NONE" NAME="foo">|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR ESCAPE='NONE' foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR foo ESCAPE='NONE'>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR NAME='foo' ESCAPE='NONE'>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<TMPL_VAR ESCAPE='NONE' NAME='foo'>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR foo ESCAPE=NONE -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR ESCAPE=NONE foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR foo ESCAPE=NONE -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR ESCAPE="NONE" foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR foo ESCAPE="NONE" -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR NAME="foo" ESCAPE="NONE" -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR ESCAPE="NONE" NAME="foo" -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR ESCAPE='NONE' foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR foo ESCAPE='NONE' -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR NAME='foo' ESCAPE='NONE' -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+<!-- TMPL_VAR ESCAPE='NONE' NAME='foo' -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery?
+
+#no escaping and default escaping
+<TMPL_VAR foo ESCAPE=0> <TMPL_VAR foo>|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery? Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?
+<!-- TMPL_VAR foo ESCAPE=0 --> <!-- TMPL_VAR foo -->|Why is Mary's house full of 100% woolen linen\haberdashery?|Why is Mary's house full of 100% woolen linen\haberdashery? Why is Mary\'s house full of 100\% woolen linen\\haberdashery\?

Property changes on: t/12-userdefined-escape.t
___________________________________________________________________
Name: svn:eol-style
   + native

Index: Template.pm
===================================================================
--- Template.pm	(revision 327)
+++ Template.pm	(working copy)
@@ -898,8 +898,42 @@
 
 default_escape - Set this parameter to "HTML", "URL" or "JS" and
 HTML::Template will apply the specified escaping to all variables
-unless they declare a different escape in the template.
+unless they declare a different escape in the template.  You may also
+set it to a user defined type, and provide a subroutine to handle the
+escaping of that type - see "escape" below.
+
+=item *
+
+escape - By using this option, you can define your own escape routines for any
+syntax you wish to use in your templates that is not one of "HTML", "URL"
+or "JS".  For example you could use HTML::Template for building SQL queries.
+See xxx SQL::Template which is a module derived from HTML::Template for
+doing just that.
+
+To use this option, you provide a hashref, using the keys as names of the
+escape schemes used in your template, and the values as references
+to a subroutines that will escape any special meaning in the context of its
+use.
 
+Using SQL as an example:
+
+   my $esc = sub {
+     my $text_ref = shift;
+     $$text_ref =~ s/\\/\\\\/g;
+     $$text_ref =~ s/'/\\'/g;
+     $$text_ref =~ s/\_/\\\_/g;
+     $$text_ref =~ s/%/\\%/g;
+   };
+
+   my $template = HTML::Template->new(filename => 'query.sqlt',
+                                      escape => { sql => $esc }
+                                      );
+
+   $template->param(interest => '6.95%') ;
+   
+   select interest,term from loan
+   where interest like '<tmpl_var name="interest" escape="sql">' ;
+   
 =back
 
 =back 4
@@ -1039,6 +1073,23 @@
     $options->{filter} = [ $options->{filter} ];
   }
   
+  # escape should be a hash and values should be refs to subs
+  if(exists $options->{escape}) {
+    if (ref($options->{escape}) ne 'HASH') {
+      croak("HTML::Template->new() called with escape option, but did not provide a hashref!");
+    }
+    if(grep((ref($_) ne 'CODE'),values(%{$options->{escape}})))  {
+      croak("HTML::Template->new() hashref provided to escape option does not provide references to subroutines as the values.");
+    }
+
+    # make hash keys for escape uppercase
+    my %h;
+    foreach my $k (keys %{$options->{escape}}) {
+      $h{uc($k)} = $options->{escape}->{$k};
+    }
+    $options->{escape} = \%h;
+  }
+  
   # make sure objects in associate area support param()
   foreach my $object (@{$options->{associate}}) {
     defined($object->can('param')) or
@@ -1112,8 +1163,11 @@
 
   if ($options->{default_escape}) {
     $options->{default_escape} = uc $options->{default_escape};
-    unless ($options->{default_escape} =~ /^(HTML|URL|JS)$/) {
-      croak("HTML::Template->new(): Invalid setting for default_escape - '$options->{default_escape}'.  Valid values are HTML, URL or JS.");
+    if($options->{default_escape} !~ /^(HTML|URL|JS)$/ && ! exists($options->{escape})) {
+      croak("HTML::Template->new(): Invalid setting for default_escape - '$options->{default_escape}'.  Valid values are HTML, URL, JS or values with matching entries with the escape option.");
+    }
+    if($options->{default_escape} !~ /^(HTML|URL|JS)$/ && ! exists($options->{escape}->{$options->{default_escape}})) {
+      croak("HTML::Template->new(): Invalid setting for default_escape - '$options->{default_escape}'.  Does not match HTML, URL, JS or any of the values provided to the escape option - " . join(',',keys(%{$options->{escape}})));
     }
   }
 
@@ -1817,6 +1871,10 @@
   my $ESCAPE = HTML::Template::ESCAPE->new();
   my $JSESCAPE = HTML::Template::JSESCAPE->new();
   my $URLESCAPE = HTML::Template::URLESCAPE->new();
+  my %USERDEFINEDESCAPE ;
+  foreach my $e (keys %{$options->{escape}}) {
+    $USERDEFINEDESCAPE{$e} = HTML::Template::USERDEFINEDESCAPE->new($e);
+  }
 
   # all the tags that need NAMEs:
   my %need_names = map { $_ => 1 } 
@@ -1891,7 +1949,8 @@
                            (?:["']?[Hh][Tt][Mm][Ll]["']?) |
                            (?:["']?[Uu][Rr][Ll]["']?) |
                            (?:["']?[Jj][Ss]["']?) |
-                           (?:["']?[Nn][Oo][Nn][Ee]["']?)
+                           (?:["']?[Nn][Oo][Nn][Ee]["']?) |
+                           (?:["']?[^'"> ]+['">]?) #USERDEFINED Escape name
                          )                         # $5 => ESCAPE on
                        )
                     )* # allow multiple ESCAPEs
@@ -1956,7 +2015,8 @@
                            (?:["']?[Hh][Tt][Mm][Ll]["']?) |
                            (?:["']?[Uu][Rr][Ll]["']?) |
                            (?:["']?[Jj][Ss]["']?) |
-                           (?:["']?[Nn][Oo][Nn][Ee]["']?)
+                           (?:["']?[Nn][Oo][Nn][Ee]["']?) |
+                           (?:["']?[^'"> ]+['">]?) #USERDEFINED Escape name
                          )                         # $15 => ESCAPE on
                        )
                     )* # allow multiple ESCAPEs
@@ -2049,8 +2109,16 @@
             # do nothing if escape=0
           } elsif ($escape =~ /^["']?[Nn][Oo][Nn][Ee]["']?$/ ) {
             # do nothing if escape=none
-          } else {
+          } elsif ($escape =~ /^["']?(?:[hH][tT][mM][lL]|1)["']?/) {
 	    push(@pstack, $ESCAPE);
+          } else { #We have a userdefined escape
+      #Remove any leading or trailing quote symbols before putting on the stack
+      $escape =~ s/^["']?([^'" ]+)["']?$/$1/;
+            #xxx need to add code here that looks up a hash with keys as the
+            #escape types and the values as objects of type HTML::Template::USERDEFINEDESCAPE
+            #xxx The code should check to make sure that the key exists for the value
+            #in $escape otherwise, croak with an error if die_on_bad_params is set
+      push(@pstack, $USERDEFINEDESCAPE{uc($escape)});
           }
         }
 
@@ -2773,7 +2841,8 @@
       *line = \$parse_stack[++$x] 
         if ref $line eq 'HTML::Template::ESCAPE' or
            ref $line eq 'HTML::Template::JSESCAPE' or
-           ref $line eq 'HTML::Template::URLESCAPE';
+           ref $line eq 'HTML::Template::URLESCAPE' or
+           ref $line eq 'HTML::Template::USERDEFINEDESCAPE';
 
       # either output the default or go back
       if (defined $$line) {
@@ -2852,6 +2921,37 @@
         s!([^a-zA-Z0-9_.\-])!$URLESCAPE_MAP{$1}!g;
         $result .= $_;
       }
+    } elsif ($type eq 'HTML::Template::USERDEFINEDESCAPE') {
+      my $escape = $$line;
+      *line = \$parse_stack[++$x];
+      if (defined($$line)) {
+        if (ref($$line) eq 'CODE') {
+            $_ = $$line->($self);
+            if ($options->{force_untaint} > 1 && tainted($_)) {
+              croak("HTML::Template->output() : 'force_untaint' option but coderef returns tainted value");
+            }
+        } else {
+            $_ = $$line;
+            if ($options->{force_untaint} > 1 && tainted($_)) {
+              croak("HTML::Template->output() : tainted value with 'force_untaint' option");
+            }
+        }
+        
+        #Check that a sub has been provided for this escape label,
+        #otherwise croak bigtime
+        unless(exists($options->{escape}->{$escape})) {
+          croak("HTML::Template->output() : No subroutine provided using escape option to new() for escape : $escape");
+        }
+        #Call subroutine stored in the $options hash passing in a reference
+        #to $_ for user routine to crunch.
+        eval {
+          &{$options->{escape}->{$escape}}(\$_);
+        };
+        croak("HTML::Template->output() : fatal error occured during escape call ($escape) : $@") if $@;
+        
+        $result .= $_;
+      }
+      next;
     } else {
       confess("HTML::Template::output() : Unknown item in parse_stack : " . $type);
     }
@@ -3121,6 +3221,16 @@
   return $self;
 }
 
+package HTML::Template::USERDEFINEDESCAPE;
+#Parameter to constructor is the name of the user defined escape type used in template
+sub new {
+  my $class = shift;
+  my $val = shift;
+  my $self = \$val;
+  bless($self,$class);
+  return $self;
+}
+
 # scalar-tying package for output(print_to => *HANDLE) implementation
 package HTML::Template::PRINTSCALAR;
 use strict;