File Coverage

blib/lib/WE_Frontend/Plugin/JS.pm
Criterion Covered Total %
statement 33 58 56.9
branch 0 4 0.0
condition n/a
subroutine 11 18 61.1
pod 1 1 100.0
total 45 81 55.5


line stmt bran cond sub pod time code
1             # -*- perl -*-
2              
3             #
4             # $Id: JS.pm,v 1.8 2005/02/03 00:06:29 eserte Exp $
5             # Author: Slaven Rezic
6             #
7             # Copyright (C) 2002,2004 Slaven Rezic. All rights reserved.
8             # This package is free software; you can redistribute it and/or
9             # modify it under the same terms as Perl itself.
10             #
11             # Mail: slaven@rezic.de
12             # WWW: http://www.rezic.de/eserte/
13             #
14              
15             package WE_Frontend::Plugin::JS;
16              
17 1     1   1250 use strict;
  1         2  
  1         37  
18 1     1   4 use vars qw($VERSION);
  1         3  
  1         64  
19             $VERSION = sprintf("%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/);
20              
21 1     1   5 use base qw(Template::Plugin);
  1         1  
  1         154  
22              
23             sub new {
24 0     0 1   my($class, $context, @args) = @_;
25 0           WE_Frontend::Plugin::JS::Quote->new($context, @args);
26 0           WE_Frontend::Plugin::JS::QuoteUnicode->new($context, @args);
27 0           WE_Frontend::Plugin::JS::Escape->new($context, @args);
28 0           bless {}, $class;
29             }
30              
31             ######################################################################
32              
33             package WE_Frontend::Plugin::JS::Quote;
34 1     1   856 use Template::Plugin::Filter;
  1         688  
  1         24  
35 1     1   6 use base qw( Template::Plugin::Filter );
  1         2  
  1         61  
36              
37 1     1   5 use vars qw(%repl $repl_keys $rx);
  1         3  
  1         280  
38             %repl = (
39             "\\" => "\\\\",
40             "\"" => "\\\"",
41             "\'" => "\\\'",
42             "\n" => "\\n",
43             "\r" => "\\r",
44             "\b" => "\\b",
45             "\f" => "\\f",
46             "\t" => "\\t",
47             );
48             for(0 .. 31) {
49             if (!exists $repl{chr($_)}) {
50             $repl{chr($_)} = "\\" . sprintf("%03o", $_);
51             }
52             }
53             $repl_keys = "(" . join("|", map { quotemeta } keys %repl) . ")";
54             $rx = qr/$repl_keys/;
55              
56             sub init {
57 0     0     my $self = shift;
58 0           $self->install_filter("js_q");
59 0           $self;
60             }
61              
62             sub filter {
63 0     0     my($self, $text) = @_;
64 0           $text =~ s/$rx/$repl{$1}/g;
65 0           $text;
66             }
67              
68             ######################################################################
69              
70             package WE_Frontend::Plugin::JS::QuoteUnicode;
71 1     1   6 use Template::Plugin::Filter;
  1         3  
  1         25  
72 1     1   6 use base qw( Template::Plugin::Filter );
  1         2  
  1         58  
73              
74 1     1   5 use vars qw(%repl $repl_keys $rx);
  1         2  
  1         289  
75             %repl = (
76             "\\" => "\\\\",
77             "\"" => "\\\"",
78             "\'" => "\\\'",
79             "\n" => "\\n",
80             "\r" => "\\r",
81             "\b" => "\\b",
82             "\f" => "\\f",
83             "\t" => "\\t",
84             );
85             for(0 .. 31) {
86             if (!exists $repl{chr($_)}) {
87             $repl{chr($_)} = "\\" . sprintf("%03o", $_);
88             }
89             }
90             $repl_keys = "(" . join("|", (map { quotemeta } keys %repl), "[\x7f-\x{fffd}]") . ")";
91             $rx = qr/$repl_keys/;
92              
93             sub init {
94 0     0     my $self = shift;
95 0           $self->install_filter("js_uni");
96 0           $self;
97             }
98              
99             sub filter {
100 0     0     my($self, $text) = @_;
101 0 0         $text =~ s/$rx/exists $repl{$1} ? $repl{$1} : sprintf "\\u%04x", ord($1)/ge;
  0            
102 0           $text;
103             }
104              
105             ######################################################################
106              
107             package WE_Frontend::Plugin::JS::Escape;
108 1     1   4 use Template::Plugin::Filter;
  1         2  
  1         16  
109 1     1   5 use base qw( Template::Plugin::Filter );
  1         2  
  1         195  
110             #use URI::Escape qw(uri_escape);
111              
112             sub init {
113 0     0     my $self = shift;
114 0           $self->install_filter("js_escape");
115 0           $self;
116             }
117              
118             sub filter {
119 0     0     my($self, $text) = @_;
120             #uri_escape($text, "^A-Za-z0-9");
121 0           $text =~ s{ ([^A-Za-z0-9]) }
122 0 0         { ord($1) > 255 ? sprintf "%%u%04x", ord $1
123             : sprintf "%%%02x", ord $1
124             }gex;
125 0           $text;
126             }
127              
128             1;
129              
130             __END__