home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / JavaScript.pm < prev    next >
Encoding:
Perl POD Document  |  2003-02-13  |  4.2 KB  |  166 lines
  1. package Data::JavaScript;
  2.  
  3. use strict;
  4. use vars qw($VERSION @ISA @EXPORT $UNDEF);
  5. use subs qw(quotemeta);
  6.  
  7. require Exporter;
  8.  
  9. @ISA = qw(Exporter);
  10. @EXPORT = qw(jsdump hjsdump);
  11.  
  12. $VERSION = 1.08;
  13. $UNDEF = q('');
  14.  
  15. sub import{
  16.   foreach( grep{ref($_)} @_ ){
  17.     if(ref($_) eq 'HASH'){
  18.       if(exists($_->{UNDEF})){
  19.     $UNDEF = $_->{UNDEF};
  20.       }
  21.     }
  22.   }
  23.   Data::JavaScript->export_to_level(1, grep {!ref($_)} @_);
  24. }
  25.  
  26. sub quotemeta {
  27.     my $text = CORE::quotemeta(shift);
  28.     $text =~ s/\\ / /g;
  29.     $text =~ s/\\([^\x20-\x7E])/sprintf("\\%03o", ord($1))/ge;
  30.     $text;
  31. }
  32.  
  33. sub jsdump {
  34.     my $sym  = shift;
  35.     return "var $sym;\n" unless (@_);
  36. #    my $elem = $#_ ? [@_] : $_[0];
  37.     my $elem  = shift;
  38.     my $undef = shift;
  39.     my %dict;
  40.     my @res   = __jsdump($sym, $elem, \%dict, $undef);
  41.     $res[0]   = "var " . $res[0];
  42.     wantarray ? @res : join("\n", @res, "");
  43. }
  44.  
  45. sub hjsdump {
  46.     my @res = ('<SCRIPT LANGUAGE="JavaScript1.2">','<!--',
  47.            &jsdump(@_), '// -->', '</SCRIPT>');
  48.     wantarray ? @res : join("\n", @res, "");
  49. }
  50.  
  51. sub __jsdump {
  52.     my ($sym, $elem, $dict, $undef) = @_;
  53.     unless (ref($elem)) {
  54.       if(! defined($elem) ){
  55.     return "$sym = @{[defined($undef) ? $undef : $UNDEF]};";
  56.       }
  57.       elsif ($elem =~ /^-?(\d+\.?\d*|\.\d+)([eE]-?\d+)?$/) {
  58.     return "$sym = " . eval($elem) . ";";
  59.       }
  60.       return "$sym = '" . quotemeta($elem) . "';";
  61.     }
  62.  
  63.     if ($dict->{$elem}) {
  64.         return "$sym = " . $dict->{$elem} . ";";
  65.     }
  66.     $dict->{$elem} = $sym;
  67.  
  68.     if (UNIVERSAL::isa($elem, 'ARRAY')) {
  69.         my @list = ("$sym = new Array;");
  70.         my $n = 0;
  71.         foreach (@$elem) {
  72.             my $newsym = "$sym\[$n]";
  73.             push(@list, __jsdump($newsym, $_, $dict, $undef));
  74.             $n++;
  75.         }
  76.         return @list;
  77.     }
  78.  
  79.     if (UNIVERSAL::isa($elem, 'HASH')) {
  80.         my @list = ("$sym = new Object;");
  81.         my ($k, $old_k, $v);
  82.         foreach $k (keys %$elem) {
  83.             $k = quotemeta($old_k=$k);
  84.             my $newsym = (($k =~ /^[a-z_]\w+$/i) ? "$sym.$k" : 
  85.                   "$sym\['$k']");
  86.             push(@list, __jsdump($newsym, $elem->{$old_k}, $dict, $undef));
  87.         }
  88.         return @list;
  89.     }
  90. }
  91.  
  92.  
  93. 1;
  94. __END__
  95.  
  96. # Below is the stub of documentation for your module. You better edit it!
  97.  
  98. =head1 NAME
  99.  
  100. Data::JavaScript - Perl extension for dumping structures into JavaScript
  101. code
  102.  
  103. =head1 SYNOPSIS
  104.  
  105.   use Data::JavaScript;
  106.   B<or>
  107.   use Data::JavaScript {UNDEF=>0};
  108.   
  109.   @code = jsdump('my_array', $array_ref, 0);
  110.   $code = jsdump('my_object', $hash_ref);
  111.   $code = hjsdump('my_stuff', $array_ref B<or> $hash_ref);
  112.  
  113. =head1 DESCRIPTION
  114.  
  115. This module is aimed mainly for CGI programming, when a perl script
  116. generates a page with client side JavaScript code that needs access to
  117. structures created on the server.
  118.  
  119. It works by creating one line of JavaScript code per datum. Therefore,
  120. structures cannot be created anonymously and needed to be assigned to
  121. variables. This enables dumping big structures.
  122.  
  123. You may define a default to be substitued in dumping of undef values
  124. at compile time by supplying the default value in anonymous hash like so
  125.  
  126.   use Data::JavaScript {UNDEF=>'null'};
  127.  
  128. =over
  129.  
  130. =item jsdump('name', \$reference, [$undef]);
  131.  
  132. The first argument is required, the name of JavaScript object to create.
  133.  
  134. The second argument is required, a hashref or arrayref.
  135. Structures can be nested, circular referrencing is supported EXPERIMENTALLY.
  136.  
  137. The third argument is optional, a scalar whose value is to be used en lieu
  138. of undefenied values when dumping a structure. If unspecified undef is output
  139. as C<''>. Other useful values might be C<0>, C<null> and C<NaN>
  140.  
  141. When called in list context, the functions return a list of lines.
  142. In scalar context, it returns a string.
  143.  
  144. =item hjsdump('name', \$reference, [$undef]);
  145.  
  146. hjsdump is identical to jsdump except that it adds HTML tags to embed the
  147. script inside an HTML page.
  148.  
  149. =back
  150.  
  151. =head1 AUTHOR
  152.  
  153. Maintained by Jerrad Pierce<jpierce@cpan.org>
  154.  
  155. Ariel Brosh, schop@cpan.org. Inspired by WDDX.pm JavaScript support.
  156.  
  157. =head1 CREDITS 
  158.  
  159. Garick Hamlin B<ghamlin@typhoon.lightning.net>, fixing of quoting bug.
  160.  
  161. =head1 SEE ALSO
  162.  
  163. perl(1), L<WDDX>.
  164.  
  165. =cut
  166.