line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package String::JS; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $DATE = '2014-07-25'; # DATE |
4
|
|
|
|
|
|
|
our $VERSION = '0.02'; # VERSION |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
29533
|
use 5.010001; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
33
|
|
7
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
8
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
20
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
1007
|
use JSON; |
|
1
|
|
|
|
|
16294
|
|
|
1
|
|
|
|
|
5
|
|
11
|
|
|
|
|
|
|
my $json = JSON->new->allow_nonref; |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
168
|
use Exporter; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
149
|
|
14
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
15
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
16
|
|
|
|
|
|
|
encode_js_string |
17
|
|
|
|
|
|
|
decode_js_string |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my %esc = ( |
21
|
|
|
|
|
|
|
"\n" => "\\n", |
22
|
|
|
|
|
|
|
"\r" => "\\r", |
23
|
|
|
|
|
|
|
"\x0b" => "\\v", |
24
|
|
|
|
|
|
|
"\t" => "\\t", |
25
|
|
|
|
|
|
|
"\b" => "\\b", |
26
|
|
|
|
|
|
|
"\f" => "\\f", |
27
|
|
|
|
|
|
|
); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub encode_js_string { |
30
|
7
|
|
|
7
|
1
|
791
|
my ($str, $mode) = @_; |
31
|
1
|
|
|
1
|
|
5
|
no warnings 'uninitialized'; # shut up warning when $str is undef |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
434
|
|
32
|
7
|
100
|
|
|
|
17
|
if ($mode) { |
33
|
5
|
100
|
|
|
|
11
|
if ($mode == 1) { |
|
|
100
|
|
|
|
|
|
34
|
2
|
|
|
|
|
10
|
$str =~ s/([\\'])/\\$1/g; |
35
|
2
|
100
|
|
|
|
13
|
return qq('$str') unless $str =~ /[^\040-\176]/; # fast exit |
36
|
1
|
|
|
|
|
5
|
$str =~ s/([\n\r\x0b\t\b\f])/$esc{$1}/g; |
37
|
1
|
|
|
|
|
2
|
$str =~ s/([\0-\037\177-\377])/sprintf('\\x%02x',ord($1))/eg; |
|
0
|
|
|
|
|
0
|
|
38
|
1
|
|
|
|
|
2
|
$str =~ s/([^\040-\176])/sprintf('\\u{%04x}',ord($1))/eg; |
|
0
|
|
|
|
|
0
|
|
39
|
1
|
|
|
|
|
5
|
return qq('$str'); |
40
|
|
|
|
|
|
|
} elsif ($mode == 2) { |
41
|
2
|
|
|
|
|
8
|
$str =~ s/([\\'"])/\\\\$1/g; |
42
|
2
|
100
|
|
|
|
12
|
return qq('$str') unless $str =~ /[^\040-\176]/; # fast exit |
43
|
1
|
|
|
|
|
5
|
$str =~ s/([\n\r\x0b\t\b\f])/\\$esc{$1}/g; |
44
|
1
|
|
|
|
|
2
|
$str =~ s/([\0-\037\177-\377])/sprintf('\\\\x%02x',ord($1))/eg; |
|
0
|
|
|
|
|
0
|
|
45
|
1
|
|
|
|
|
3
|
$str =~ s/([^\040-\176])/sprintf('\\\\u{%04x}',ord($1))/eg; |
|
0
|
|
|
|
|
0
|
|
46
|
1
|
|
|
|
|
6
|
return qq('$str'); |
47
|
|
|
|
|
|
|
} else { |
48
|
1
|
|
|
|
|
10
|
die "Invalid mode, must be 0, 1, or 2"; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} else { |
51
|
2
|
|
|
|
|
39
|
return $json->encode("$str"); |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub decode_js_string { |
56
|
2
|
|
|
2
|
1
|
1286
|
my $str = shift; |
57
|
2
|
100
|
|
|
|
13
|
if ($str =~ /\A"/o) { |
|
|
50
|
|
|
|
|
|
58
|
1
|
|
|
|
|
14
|
$json->decode($str); |
59
|
|
|
|
|
|
|
} elsif ($str =~ /\A'/o) { |
60
|
0
|
|
|
|
|
0
|
die "Decoding JavaScript string with single quotes not yet implemented"; |
61
|
|
|
|
|
|
|
} else { |
62
|
1
|
|
|
|
|
9
|
die "Invalid JavaScript string literal"; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
1; |
67
|
|
|
|
|
|
|
# ABSTRACT: Utilities for Javascript string literal representation |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
__END__ |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=pod |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=encoding UTF-8 |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head1 NAME |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
String::JS - Utilities for Javascript string literal representation |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=head1 VERSION |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
This document describes version 0.02 of String::JS (from Perl distribution String-JS), released on 2014-07-25. |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head1 FUNCTIONS |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head2 encode_js_string($str[, $mode]) => STR |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
Encode Perl string C<$str> to its JavaScript literal representation using double |
88
|
|
|
|
|
|
|
quotes (C<">). This is currently implemented using JSON encoding. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
If C<$mode> is set to 1, will produce literal representation using single quotes |
91
|
|
|
|
|
|
|
(C<'>) instead. |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
If C<$mode> is set to 2, will produce single-quoted JS string to be put inside a |
94
|
|
|
|
|
|
|
double-quoted JS string literal, useful for producing for example jQuery |
95
|
|
|
|
|
|
|
expression like: |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
$("h2.contains('this is JS string inside another JS string')") |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
Will die on failure. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head2 decode_js_string($js_str) => STR |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
Given a JavaScript string literal representation in C<$js_str>, decode to get |
104
|
|
|
|
|
|
|
the value. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Currently implemented using JSON decoding of stringified C<$js_str>. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
Currently does not support JavaScript string representation that uses single |
109
|
|
|
|
|
|
|
quotes (C<'>). |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Will die on failure. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head1 SEE ALSO |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
L<JSON> |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=head1 HOMEPAGE |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
Please visit the project's homepage at L<https://metacpan.org/release/String-JS>. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=head1 SOURCE |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
Source repository is at L<https://github.com/sharyanto/perl-String-JS>. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head1 BUGS |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=String-JS> |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
When submitting a bug or request, please include a test-file or a |
130
|
|
|
|
|
|
|
patch to an existing test-file that illustrates the bug or desired |
131
|
|
|
|
|
|
|
feature. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head1 AUTHOR |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
Steven Haryanto <stevenharyanto@gmail.com> |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
This software is copyright (c) 2014 by Steven Haryanto. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
142
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=cut |