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