r24565 - in /branches/upstream/libdata-javascript-perl/current: CHANGES JavaScript.pm MANIFEST TODO t/1-load.t t/1.t t/2-import.t t/2.t t/3-js12.t t/3-noArgs.t t/3-undef.t t/3.t t/4-escape.t t/4.t t/5.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun Aug 24 13:05:52 UTC 2008
Author: ansgar-guest
Date: Sun Aug 24 13:05:49 2008
New Revision: 24565
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=24565
Log:
[svn-upgrade] Integrating new upstream version, libdata-javascript-perl (1.13)
Added:
branches/upstream/libdata-javascript-perl/current/t/1-load.t
branches/upstream/libdata-javascript-perl/current/t/2-import.t
branches/upstream/libdata-javascript-perl/current/t/3-js12.t
branches/upstream/libdata-javascript-perl/current/t/3-noArgs.t
branches/upstream/libdata-javascript-perl/current/t/3-undef.t
branches/upstream/libdata-javascript-perl/current/t/4-escape.t
Removed:
branches/upstream/libdata-javascript-perl/current/t/1.t
branches/upstream/libdata-javascript-perl/current/t/2.t
branches/upstream/libdata-javascript-perl/current/t/3.t
branches/upstream/libdata-javascript-perl/current/t/4.t
branches/upstream/libdata-javascript-perl/current/t/5.t
Modified:
branches/upstream/libdata-javascript-perl/current/CHANGES
branches/upstream/libdata-javascript-perl/current/JavaScript.pm
branches/upstream/libdata-javascript-perl/current/MANIFEST
branches/upstream/libdata-javascript-perl/current/TODO
Modified: branches/upstream/libdata-javascript-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-javascript-perl/current/CHANGES?rev=24565&op=diff
==============================================================================
--- branches/upstream/libdata-javascript-perl/current/CHANGES (original)
+++ branches/upstream/libdata-javascript-perl/current/CHANGES Sun Aug 24 13:05:49 2008
@@ -1,6 +1,20 @@
Revision history for Perl extension Data::JavaScript.
-1.11 Tue Nov 15 14:30:22 EST 2005
+1.13 Thu Aug 14 11:01:10 EDT 2008
+ - Finished implementing import
+ - "Simplified"/unified __quotemeta code forks
+
+1.12 Wed Aug 13 22:48:12 EDT 2008
+ - Some minor refactoring, including the removal of a dependency on
+ Exporter
+ - Fixed a misnumbered test in 1_11, which was intended to be a
+ development release.
+ - Escape </script> based on reports of certain stupid browsers
+ ceasing to parse JavaScript upon encountering this string,
+ even in strings.
+ - Added explicit license
+
+1_11 Tue Nov 15 14:30:22 EST 2005
- Touched up documentation
- Fixed syntax errors for hash key names that are also JS keywords
Reported by Kevin J. of Activestate
Modified: branches/upstream/libdata-javascript-perl/current/JavaScript.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-javascript-perl/current/JavaScript.pm?rev=24565&op=diff
==============================================================================
--- branches/upstream/libdata-javascript-perl/current/JavaScript.pm (original)
+++ branches/upstream/libdata-javascript-perl/current/JavaScript.pm Sun Aug 24 13:05:49 2008
@@ -1,32 +1,53 @@
package Data::JavaScript;
require 5;
-use vars qw(@EXPORT @EXPORT_OK @ISA %OPT $VERSION);
+use vars qw(@EXPORT @EXPORT_OK %OPT $VERSION);
%OPT = (JS=>1.3);
-$VERSION = 1.11;
-
-use Exporter;
+$VERSION = 1.13;
+
@EXPORT = qw(jsdump hjsdump);
@EXPORT_OK = '__quotemeta';
- at ISA = qw(Exporter);
use strict;
require Encode unless $] < 5.007;
sub import{
+ my $package = shift;
+
foreach( @_ ){
if(ref($_) eq 'HASH'){
- foreach my $opt ( 'UNDEF', 'JS' ){
- if(exists($_->{$opt})){
- $OPT{$opt} = $_->{$opt};
- }
+ $OPT{JS} = $$_{JS} if exists($$_{JS});
+ $OPT{UNDEF} = $$_{UNDEF} if exists($$_{UNDEF});
+ }
+ }
+ $OPT{UNDEF} ||= $OPT{JS} > 1.2 ? 'undefined' : q('');
+
+ #use (); #imports nothing, as package is not supplied
+ if( defined $package ){
+ no strict 'refs';
+
+ #Remove options hash
+ my @import = grep { ! length ref } @_;
+
+ if( scalar @import ){
+ if( grep {/^:all$/} @import ){
+ @import = (@EXPORT, @EXPORT_OK) }
+ else{
+ #only user-specfied subset of @EXPORT, @EXPORT_OK
+ my $q = qr/@{[join('|', @EXPORT, @EXPORT_OK)]}/;
+ @import = grep { $_ =~ /$q/ } @import;
}
}
+ else{
+ @import = @EXPORT;
+ }
+
+ my $caller = caller;
+ for my $func (@import) {
+ *{"$caller\::$func"} = \&$func;
+ }
}
- $OPT{UNDEF} = exists($OPT{UNDEF}) || $OPT{JS} > 1.2 ? 'undefined' : q('');
- Data::JavaScript->export_to_level(1, grep {!ref($_)} @_);
-}
-
-#XXX version, ECMAscript even. Charset!
+}
+
sub hjsdump {
my @res = (qq(<script type="text/javascript" language="JavaScript$OPT{JS}" />),
'<!--', &jsdump(@_), '// -->', '</script>');
@@ -44,52 +65,49 @@
wantarray ? @res : join("\n", @res, "");
}
+
+my $QMver;
if( $] < 5.007 ){
- eval <<'EO5';
-sub __quotemeta {
- local $_ = shift;
-
- s<([^ \x21-\x5B\x5D-\x7E]+)>{sprintf(join('', '\x%02X' x length$1), unpack'C*',$1)}ge;
-
- #This is kind of ugly/inconsistent output for munged UTF-8
- s/\\x09/\\t/g;
- s/\\x0A/\\n/g;
- s/\\x0D/\\r/g;
- s/"/\\"/g;
- s/\\x5C/\\\\/g;
-
- return $_;
-}
+ $QMver=<<'EO5';
+ s<([^ \x21-\x5B\x5D-\x7E]+)>{sprintf(join('', '\x%02X' x length$1), unpack'C*',$1)}ge;
EO5
}
- else{
- eval<<'EO58';
-sub __quotemeta {
- local $_ = shift;
- if( $OPT{JS} >= 1.3 && Encode::is_utf8($_) ){
- s<([\x{0080}-\x{fffd}]+)>{sprintf '\u%0*v4X', '\u', $1}ge;
+else{
+ $QMver=<<'EO58';
+ if( $OPT{JS} >= 1.3 && Encode::is_utf8($_) ){
+ s<([\x{0080}-\x{fffd}]+)>{sprintf '\u%0*v4X', '\u', $1}ge;
+ }
+
+ {
+ use bytes;
+ s<((?:[^ \x21-\x7E]|(?:\\(?!u)))+)>{sprintf '\x%0*v2X', '\x', $1}ge;
+ }
+EO58
+}
+
+eval 'sub __quotemeta {local $_ = shift;' . $QMver . <<'EOQM';
+
+ #This is kind of ugly/inconsistent output for munged UTF-8
+ #tr won't work because we need the escaped \ for JS output
+ s/\\x09/\\t/g;
+ s/\\x0A/\\n/g;
+ s/\\x0D/\\r/g;
+ s/"/\\"/g;
+ s/\\x5C/\\\\/g;
+
+ #Escape </script> for stupid browsers that stop parsing
+ s%</script>%\\x3C\\x2Fscript\\x3E%g;
+
+ return $_;
}
-
- {
- use bytes;
- s<((?:[^ \x21-\x7E]|(?:\\(?!u)))+)>{sprintf '\x%0*v2X', '\x', $1}ge;
- }
-
- s/\\x09/\\t/g;
- s/\\x0A/\\n/g;
- s/\\x0D/\\r/g;
- s/"/\\"/g;
- s/\\x5C/\\\\/g;
-
- return $_;
-}
-EO58
-}
+EOQM
+
sub __jsdump {
my ($sym, $elem, $dict, $undef) = @_;
-
- unless (ref($elem)) {
+ my $ref;
+
+ unless( $ref = ref($elem) ){
unless( defined($elem) ){
return "$sym = @{[defined($undef) ? $undef : $OPT{UNDEF}]};";
}
@@ -111,7 +129,8 @@
}
$dict->{$elem} = $sym;
- if (UNIVERSAL::isa($elem, 'ARRAY')) {
+ #isa over ref in case we're given objects
+ if( $ref eq 'ARRAY' || UNIVERSAL::isa($elem, 'ARRAY') ){
my @list = ("$sym = new Array;");
my $n = 0;
foreach (@$elem) {
@@ -121,8 +140,7 @@
}
return @list;
}
-
- if (UNIVERSAL::isa($elem, 'HASH')) {
+ elsif( $ref eq 'HASH' || UNIVERSAL::isa($elem, 'HASH') ){
my @list = ("$sym = new Object;");
my ($k, $old_k, $v);
foreach $k (sort keys %$elem) {
@@ -132,6 +150,9 @@
}
return @list;
}
+ else{
+ return "//Unknown reference: $sym=$ref";
+ }
}
@@ -152,7 +173,7 @@
=head1 DESCRIPTION
-This module is mainly inteded for CGI programming, when a perl script
+This module is mainly intended for CGI programming, when a perl script
generates a page with client side JavaScript code that needs access to
structures created on the server.
@@ -176,6 +197,11 @@
Other useful values might be C<0>, C<null>, or C<NaN>.
+=head1 EXPORT
+
+In addition, althought the module no longer uses Exporter, it heeds its
+import conventions; C<qw(:all>), C<()>, etc.
+
=over
=item jsdump('name', \$reference, [$undef]);
@@ -195,10 +221,16 @@
hjsdump is identical to jsdump except that it wraps the content in script tags.
+=back
+
+=head1 EXPORTABLE
+
+=over
+
=item __quotemeta($str)
-Not exported by default, this function escapes non-printable and Unicode
-characters to promote playing nice with others.
+This function escapes non-printable and Unicode characters (where possible)
+to promote playing nice with others.
=back
@@ -207,7 +239,8 @@
Previously, the module eval'd any data it received that looked like a number;
read: real, hexadecimal, octal, or engineering notations. It now passes all
non-decimal values through as strings. You will need to C<eval> on the client
-or server side if you wish to use other notations as numbers.
+or server side if you wish to use other notations as numbers. This is meant
+to protect people who store ZIP codes with leading 0's.
Unicode support requires perl 5.8 or later. Older perls will gleefully escape
the non-printable portions of any UTF-8 they are fed, likely munging it in
@@ -215,9 +248,26 @@
problem and there is sufficient interest it may be possible to hack-in UTF-8
escaping for older perls.
+=head1 LICENSE
+
+=over
+
+=item * Thou shalt not claim ownership of unmodified materials.
+
+=item * Thou shalt not claim whole ownership of modified materials.
+
+=item * Thou shalt grant the indemnity of the provider of materials.
+
+=item * Thou shalt use and dispense freely without other restrictions.
+
+=back
+
+Or if you truly insist, you may use and distribute this under ther terms
+of Perl itself (GPL and/or Artistic License).
+
=head1 SEE ALSO
-L<Data::JavaScript::LiteObject>, L<Data::JavaScript::Anon>, L<CGI::AJAX>
+L<Data::JavaScript::LiteObject>, L<Data::JavaScript::Anon>, L<CGI::AJAX|CGI::Ajax>
=head1 AUTHOR
Modified: branches/upstream/libdata-javascript-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-javascript-perl/current/MANIFEST?rev=24565&op=diff
==============================================================================
--- branches/upstream/libdata-javascript-perl/current/MANIFEST (original)
+++ branches/upstream/libdata-javascript-perl/current/MANIFEST Sun Aug 24 13:05:49 2008
@@ -4,9 +4,10 @@
TODO
JavaScript.pm
Makefile.PL
-t/1.t
-t/2.t
-t/3.t
-t/4.t
-t/5.t
+t/1-load.t
+t/2-import.t
+t/3-js12.t
+t/3-noArgs.t
+t/3-undef.t
+t/4-escape.t
example.pl
Modified: branches/upstream/libdata-javascript-perl/current/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-javascript-perl/current/TODO?rev=24565&op=diff
==============================================================================
--- branches/upstream/libdata-javascript-perl/current/TODO (original)
+++ branches/upstream/libdata-javascript-perl/current/TODO Sun Aug 24 13:05:49 2008
@@ -1,16 +1,19 @@
ECMAScript and charset support for hjsdump
- Encoding, escape [^[:print:]]
+
+Encoding, escape [^[:print:]]
+ Doesn't seem to include Unicode in 5.8.4...
Numbers
- Infinity
+ Infinity
- NaN
+ NaN
- const
+ const (check attribute?)
Lightweight (object initializer) output for 1.2+
JavaScript 1.2 and later support a compact object notation known
- as object literals. Instead of the verbose...
+ as object literals. We probably want to walk depth first if using
+ this notation.
HASH = {key:val}
ARRAY= [0, 1, 2]
Added: branches/upstream/libdata-javascript-perl/current/t/1-load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-javascript-perl/current/t/1-load.t?rev=24565&op=file
==============================================================================
--- branches/upstream/libdata-javascript-perl/current/t/1-load.t (added)
+++ branches/upstream/libdata-javascript-perl/current/t/1-load.t Sun Aug 24 13:05:49 2008
@@ -1,0 +1,6 @@
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Data::JavaScript;
+$loaded = 1;
+print "ok 1 #Loads fine\n";
+
Added: branches/upstream/libdata-javascript-perl/current/t/2-import.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-javascript-perl/current/t/2-import.t?rev=24565&op=file
==============================================================================
--- branches/upstream/libdata-javascript-perl/current/t/2-import.t (added)
+++ branches/upstream/libdata-javascript-perl/current/t/2-import.t Sun Aug 24 13:05:49 2008
@@ -1,0 +1,25 @@
+BEGIN { $| = 1; print "1..3\n"; }
+
+#Test imports
+
+{
+ package Fred;
+ use Data::JavaScript qw(:all);
+
+ $_ = eval{ __quotemeta("Hello World\n") };
+ print 'not ' unless $_ eq 'Hello World\n';
+ print "ok 1 #$_\n";
+}
+
+{
+ package Barney;
+ use Data::JavaScript qw(jsdump);
+
+ $_ = eval{ __quotemeta("Hello World\n") } || '';
+ print 'not ' if $_ eq 'Hello World\n';
+ print "ok 2 #$_\n";
+
+ $_ = join('', jsdump('narf', 'Troz!'));
+ print 'not ' unless $_ eq 'var narf = "Troz!";';
+ print "ok 3 #$_\n";
+}
Added: branches/upstream/libdata-javascript-perl/current/t/3-js12.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-javascript-perl/current/t/3-js12.t?rev=24565&op=file
==============================================================================
--- branches/upstream/libdata-javascript-perl/current/t/3-js12.t (added)
+++ branches/upstream/libdata-javascript-perl/current/t/3-js12.t Sun Aug 24 13:05:49 2008
@@ -1,0 +1,30 @@
+#Lame switch because old Test::Harness does not support trailing test count
+BEGIN { $| = 1; print "1..4\n" }
+use Data::JavaScript {JS=>1.2}; #No Unicode, undef yields empty strings
+
+#Test undef default
+
+$_ = join('', jsdump('foo', [1,undef,1]));
+print 'not ' unless $_ eq
+ "var foo = new Array;foo[0] = 1;foo[1] = '';foo[2] = 1;";
+print "ok 1 #$_\n";
+
+#Test alphanumeric string output: quoting, ASCII/ANSI escaping, Unicode
+
+$_ = join('', jsdump("ANSI", "M\xF6tley Cr\xFce"));
+print 'not ' unless $_ eq 'var ANSI = "M\xF6tley Cr\xFCe";';
+print "ok 2 #$_\n";
+
+if( $] >= 5.006 ){
+ $_ = join('', jsdump("unicode", "Euros (\x{20ac}) aren't Ecus (\x{20a0})"));
+ print 'not ' unless $_ eq
+ q(var unicode = "Euros (\xE2\x82\xAC) aren't Ecus (\xE2\x82\xA0)";);
+ print "ok 3 #$_\n";
+}
+else{
+ print "ok 3 # Skipped: No real Unicode\n";
+}
+
+$_ = join('', jsdump('thang', qq(' "\n\\\xa0) ));
+print 'not ' unless $_ eq q(var thang = "'\t\"\n\\\\\xA0";);
+print "ok 4 #$_\n";
Added: branches/upstream/libdata-javascript-perl/current/t/3-noArgs.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-javascript-perl/current/t/3-noArgs.t?rev=24565&op=file
==============================================================================
--- branches/upstream/libdata-javascript-perl/current/t/3-noArgs.t (added)
+++ branches/upstream/libdata-javascript-perl/current/t/3-noArgs.t Sun Aug 24 13:05:49 2008
@@ -1,0 +1,25 @@
+BEGIN { $| = 1; $] < 5.007 ?
+ do{ print "1..0 # Skipped: No real Unicode\n"; exit} : print "1..4\n"; }
+use Data::JavaScript;
+
+#Test undef default
+
+$_ = join('', jsdump('foo', [1,undef,1]));
+print 'not ' unless $_ eq
+ 'var foo = new Array;foo[0] = 1;foo[1] = undefined;foo[2] = 1;';
+print "ok 1 #$_\n";
+
+#Test alphanumeric string output: quoting, ASCII/ANSI escaping, Unicode
+
+$_ = join('', jsdump("ANSI", "M\xF6tley Cr\xFce"));
+print 'not ' unless $_ eq 'var ANSI = "M\xF6tley Cr\xFCe";';
+print "ok 2 #$_\n";
+
+$_ = join('', jsdump("unicode", "Euros (\x{20ac}) aren't Ecus (\x{20a0})"));
+print 'not ' unless $_ eq
+ q(var unicode = "Euros (\u20AC) aren't Ecus (\u20A0)";);
+print "ok 3 #$_\n";
+
+$_ = join('', jsdump("Cherokee", "\x{13E3}\x{13E3}\x{13E3}"));
+print 'not ' unless $_ eq q(var Cherokee = "\u13E3\u13E3\u13E3";);
+print "ok 4 #$_\n";
Added: branches/upstream/libdata-javascript-perl/current/t/3-undef.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-javascript-perl/current/t/3-undef.t?rev=24565&op=file
==============================================================================
--- branches/upstream/libdata-javascript-perl/current/t/3-undef.t (added)
+++ branches/upstream/libdata-javascript-perl/current/t/3-undef.t Sun Aug 24 13:05:49 2008
@@ -1,0 +1,20 @@
+BEGIN { $| = 1; print "1..3\n"; }
+use Data::JavaScript {UNDEF=>0};
+
+#Test undef value overloading
+
+$_ = join('', jsdump('foo', [1,undef,1]));
+print 'not ' unless $_ eq
+ 'var foo = new Array;foo[0] = 1;foo[1] = undefined;foo[2] = 1;';
+print "ok 1 #$_\n";
+
+$_ = join('', jsdump('bar', [1,undef,1], 'null'));
+print 'not ' unless $_ eq
+ 'var bar = new Array;bar[0] = 1;bar[1] = null;bar[2] = 1;';
+print "ok 2 #$_\n";
+
+#Test hashes
+$_ = join('', jsdump('qux', {color=>'monkey', age=>2, eyes=>'blue'}));
+print 'not ' unless $_ eq
+ 'var qux = new Object;qux["age"] = 2;qux["color"] = "monkey";qux["eyes"] = "blue";';
+print "ok 3 #$_\n";
Added: branches/upstream/libdata-javascript-perl/current/t/4-escape.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-javascript-perl/current/t/4-escape.t?rev=24565&op=file
==============================================================================
--- branches/upstream/libdata-javascript-perl/current/t/4-escape.t (added)
+++ branches/upstream/libdata-javascript-perl/current/t/4-escape.t Sun Aug 24 13:05:49 2008
@@ -1,0 +1,29 @@
+BEGIN { $| = 1; print "1..6\n"; }
+
+use Data::JavaScript;
+
+#Test numbers: negative, real, engineering, octal/zipcode
+
+$_ = join('', jsdump('ixi', -1));
+print 'not ' unless $_ eq 'var ixi = -1;';
+print "ok 1 #$_\n";
+
+$_ = join('', jsdump('pi', 3.14159));
+print 'not ' unless $_ eq 'var pi = 3.14159;';
+print "ok 2 #$_\n";
+
+$_ = join('', jsdump('c', '3E8'));
+print 'not ' unless $_ eq 'var c = "3E8";';
+print "ok 3 #$_\n";
+
+$_ = join('', jsdump('zipcode', '02139'));
+print 'not ' unless $_ eq 'var zipcode = "02139";';
+print "ok 4 #$_\n";
+
+$_ = join('', jsdump('hex', '0xdeadbeef'));
+print 'not ' unless $_ eq 'var hex = "0xdeadbeef";';
+print "ok 5 #$_\n";
+
+$_ = join('', jsdump("IEsux", "</script>DoS!"));
+print 'not ' unless $_ eq 'var IEsux = "\x3C\x2Fscript\x3EDoS!";';
+print "ok 6 #$_\n";
More information about the Pkg-perl-cvs-commits
mailing list