mirror of
https://github.com/perlbot/perlbuut
synced 2025-06-07 10:45:40 -04:00
cleaning some stuff up, i don't need the deps stuff, i also cleaned up some warnings in almost all the plugins, and removed a few plugins i don't want
This commit is contained in:
parent
0d73e35eab
commit
1b42ed6147
260 changed files with 76 additions and 67065 deletions
170
deps/IMDB/.svn/entries
vendored
170
deps/IMDB/.svn/entries
vendored
|
|
@ -1,170 +0,0 @@
|
|||
10
|
||||
|
||||
dir
|
||||
475
|
||||
svn://erxz.com/bb3/branches/perlbuut/deps/IMDB
|
||||
svn://erxz.com/bb3
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
dcb1cea6-7f7e-4c78-8a22-148ace8ce36e
|
||||
|
||||
t
|
||||
dir
|
||||
|
||||
lib
|
||||
dir
|
||||
|
||||
MANIFEST
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
b2b4bb53f7628be730b9d4b603a754b8
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
57
|
||||
|
||||
Makefile.PL
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
a013e7f0b4a91e2d8970394935efdaea
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
509
|
||||
|
||||
Changes
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
440b02384d58aa9be2b95e1133736122
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
152
|
||||
|
||||
README
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
dee33c52c01d661c31f7948418d11118
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
1161
|
||||
|
||||
6
deps/IMDB/.svn/text-base/Changes.svn-base
vendored
6
deps/IMDB/.svn/text-base/Changes.svn-base
vendored
|
|
@ -1,6 +0,0 @@
|
|||
Revision history for Perl extension IMDB.
|
||||
|
||||
0.01 Sun Jun 7 19:27:43 2009
|
||||
- original version; created by h2xs 1.23 with options
|
||||
-b 5.0.0 -X -n IMDB
|
||||
|
||||
6
deps/IMDB/.svn/text-base/MANIFEST.svn-base
vendored
6
deps/IMDB/.svn/text-base/MANIFEST.svn-base
vendored
|
|
@ -1,6 +0,0 @@
|
|||
Changes
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
README
|
||||
t/IMDB.t
|
||||
lib/IMDB.pm
|
||||
12
deps/IMDB/.svn/text-base/Makefile.PL.svn-base
vendored
12
deps/IMDB/.svn/text-base/Makefile.PL.svn-base
vendored
|
|
@ -1,12 +0,0 @@
|
|||
use 5.000;
|
||||
use ExtUtils::MakeMaker;
|
||||
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
# the contents of the Makefile that is written.
|
||||
WriteMakefile(
|
||||
NAME => 'IMDB',
|
||||
VERSION_FROM => 'lib/IMDB.pm', # finds $VERSION
|
||||
PREREQ_PM => {}, # e.g., Module::Name => 1.1
|
||||
($] >= 5.005 ? ## Add these new keywords supported since 5.005
|
||||
(ABSTRACT_FROM => 'lib/IMDB.pm', # retrieve abstract from module
|
||||
AUTHOR => 'A. U. Thor <buu@>') : ()),
|
||||
);
|
||||
40
deps/IMDB/.svn/text-base/README.svn-base
vendored
40
deps/IMDB/.svn/text-base/README.svn-base
vendored
|
|
@ -1,40 +0,0 @@
|
|||
IMDB version 0.01
|
||||
=================
|
||||
|
||||
The README is used to introduce the module and provide instructions on
|
||||
how to install the module, any machine dependencies it may have (for
|
||||
example C compilers and installed libraries) and any other information
|
||||
that should be provided before the module is installed.
|
||||
|
||||
A README file is required for CPAN modules since CPAN extracts the
|
||||
README file from a module distribution so that people browsing the
|
||||
archive can use it get an idea of the modules uses. It is usually a
|
||||
good idea to provide version information here so that people can
|
||||
decide whether fixes for the module are worth downloading.
|
||||
|
||||
INSTALLATION
|
||||
|
||||
To install this module type the following:
|
||||
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
DEPENDENCIES
|
||||
|
||||
This module requires these other modules and libraries:
|
||||
|
||||
blah blah blah
|
||||
|
||||
COPYRIGHT AND LICENCE
|
||||
|
||||
Put the correct copyright and licence information here.
|
||||
|
||||
Copyright (C) 2009 by A. U. Thor
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.10.0 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
6
deps/IMDB/Changes
vendored
6
deps/IMDB/Changes
vendored
|
|
@ -1,6 +0,0 @@
|
|||
Revision history for Perl extension IMDB.
|
||||
|
||||
0.01 Sun Jun 7 19:27:43 2009
|
||||
- original version; created by h2xs 1.23 with options
|
||||
-b 5.0.0 -X -n IMDB
|
||||
|
||||
6
deps/IMDB/MANIFEST
vendored
6
deps/IMDB/MANIFEST
vendored
|
|
@ -1,6 +0,0 @@
|
|||
Changes
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
README
|
||||
t/IMDB.t
|
||||
lib/IMDB.pm
|
||||
12
deps/IMDB/Makefile.PL
vendored
12
deps/IMDB/Makefile.PL
vendored
|
|
@ -1,12 +0,0 @@
|
|||
use 5.000;
|
||||
use ExtUtils::MakeMaker;
|
||||
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
# the contents of the Makefile that is written.
|
||||
WriteMakefile(
|
||||
NAME => 'IMDB',
|
||||
VERSION_FROM => 'lib/IMDB.pm', # finds $VERSION
|
||||
PREREQ_PM => {}, # e.g., Module::Name => 1.1
|
||||
($] >= 5.005 ? ## Add these new keywords supported since 5.005
|
||||
(ABSTRACT_FROM => 'lib/IMDB.pm', # retrieve abstract from module
|
||||
AUTHOR => 'A. U. Thor <buu@>') : ()),
|
||||
);
|
||||
40
deps/IMDB/README
vendored
40
deps/IMDB/README
vendored
|
|
@ -1,40 +0,0 @@
|
|||
IMDB version 0.01
|
||||
=================
|
||||
|
||||
The README is used to introduce the module and provide instructions on
|
||||
how to install the module, any machine dependencies it may have (for
|
||||
example C compilers and installed libraries) and any other information
|
||||
that should be provided before the module is installed.
|
||||
|
||||
A README file is required for CPAN modules since CPAN extracts the
|
||||
README file from a module distribution so that people browsing the
|
||||
archive can use it get an idea of the modules uses. It is usually a
|
||||
good idea to provide version information here so that people can
|
||||
decide whether fixes for the module are worth downloading.
|
||||
|
||||
INSTALLATION
|
||||
|
||||
To install this module type the following:
|
||||
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
DEPENDENCIES
|
||||
|
||||
This module requires these other modules and libraries:
|
||||
|
||||
blah blah blah
|
||||
|
||||
COPYRIGHT AND LICENCE
|
||||
|
||||
Put the correct copyright and licence information here.
|
||||
|
||||
Copyright (C) 2009 by A. U. Thor
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.10.0 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
|
||||
62
deps/IMDB/lib/.svn/entries
vendored
62
deps/IMDB/lib/.svn/entries
vendored
|
|
@ -1,62 +0,0 @@
|
|||
10
|
||||
|
||||
dir
|
||||
475
|
||||
svn://erxz.com/bb3/branches/perlbuut/deps/IMDB/lib
|
||||
svn://erxz.com/bb3
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
dcb1cea6-7f7e-4c78-8a22-148ace8ce36e
|
||||
|
||||
IMDB.pm
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
50c116175e3d733ef0edbd95b2e4213c
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
4954
|
||||
|
||||
241
deps/IMDB/lib/.svn/text-base/IMDB.pm.svn-base
vendored
241
deps/IMDB/lib/.svn/text-base/IMDB.pm.svn-base
vendored
|
|
@ -1,241 +0,0 @@
|
|||
package IMDB;
|
||||
use HTML::TreeBuilder;
|
||||
use URI;
|
||||
use LWP::Simple qw/get/;
|
||||
use URI::Escape qw/uri_escape/;
|
||||
use strict;
|
||||
|
||||
|
||||
sub normalize_title
|
||||
{
|
||||
my( $self, $title ) = @_;
|
||||
|
||||
$title =~ tr/'"[]//d;
|
||||
$title =~ s/ +/ /g;
|
||||
return $title;
|
||||
}
|
||||
|
||||
sub new
|
||||
{
|
||||
my( $class, $title ) = @_;
|
||||
my $self = bless {}, $class;
|
||||
|
||||
my ($uri,$tree) = $self->search( $title );
|
||||
return unless defined $tree;
|
||||
|
||||
$self->get_title($tree);
|
||||
$self->get_basic_info($tree);
|
||||
|
||||
for( qw/plotsummary fullcredits trivia quotes/ )
|
||||
{
|
||||
warn "Fetching $uri$_\n";
|
||||
my $html = get( "$uri$_" );
|
||||
my $tree = HTML::TreeBuilder->new;
|
||||
$tree->parse($html);
|
||||
$tree->eof;
|
||||
|
||||
my $method_name = "get_$_";
|
||||
$self->$method_name($tree);
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub search
|
||||
{
|
||||
my( $self, $title ) = @_;
|
||||
my $search_uri = "http://www.imdb.com/find?s=all&q=" . uri_escape($self->normalize_title($title));
|
||||
warn "Fetching $search_uri\n";
|
||||
my $html = get($search_uri);
|
||||
|
||||
my $tree = HTML::TreeBuilder->new;
|
||||
$tree->parse($html);
|
||||
$tree->eof;
|
||||
|
||||
if( not $tree->look_down(_tag => "title")->as_text =~ /IMDb.*Search/ )
|
||||
{
|
||||
my $link = $tree->look_down( _tag => 'a', href => qr#/title/tt# );
|
||||
$link->attr('href') =~ m'(/title/tt\d+)';
|
||||
return ( "http://www.imdb.com$1",$tree );
|
||||
}
|
||||
|
||||
#This gets the initial header for the search results. <h2>Popular Results</h2>
|
||||
my $top_ele = $tree->look_down( _tag => 'b', sub { $_[0]->as_text eq 'Popular Titles' } );
|
||||
|
||||
if( $top_ele and ($top_ele->parent->content_list)[2] )
|
||||
{
|
||||
$top_ele = ($top_ele->parent->content_list)[2]; #Should be the opening tag for the follow list of links.
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
$top_ele = $tree->look_down( _tag => 'b', sub { $_[0]->as_text eq 'Titles (Exact Matches)' } );
|
||||
|
||||
if( $top_ele )
|
||||
{
|
||||
$top_ele = ($top_ele->right)[1];
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
$top_ele = $tree->look_down( _tag => 'b', sub { $_[0]->as_text eq 'Titles (Approx Matches)' } );
|
||||
|
||||
if( $top_ele )
|
||||
{
|
||||
$top_ele = ($top_ele->right)[1];
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
$top_ele = $tree->look_down( _tag => 'b', sub { $_[0]->as_text eq 'Titles (Partial Matches)' } );
|
||||
|
||||
if( $top_ele )
|
||||
{
|
||||
$top_ele = ($top_ele->right)[1];
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
warn "Error, could not find a useful result for term $title\n";
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# warn "Top ele -- ", $top_ele->as_HTML;
|
||||
|
||||
my $first_link = $top_ele->look_down( _tag => 'a' ); #We only want the first link anyway.
|
||||
|
||||
my $path = URI->new($first_link->attr('href'))->path;
|
||||
my $uri = URI->new_abs( $path, "http://imdb.com");
|
||||
$self->{data}->{uri} = $uri;
|
||||
|
||||
my $actual_html = get( $uri );
|
||||
my $new_tree = HTML::TreeBuilder->new;
|
||||
$new_tree->parse($actual_html);
|
||||
return ($uri,$new_tree);
|
||||
}
|
||||
|
||||
|
||||
sub get_title
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
|
||||
my $title = $tree->look_down(_tag => "title");
|
||||
$self->{data}->{title} = $title->as_text if $title;
|
||||
}
|
||||
|
||||
sub get_basic_info
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
|
||||
my $rdate = $tree->look_down( _tag => 'h5', sub { $_[0]->as_text eq 'Release Date:' } );
|
||||
$self->{data}->{release_date} = $rdate->right if $rdate;
|
||||
my $genre_title = $tree->look_down( _tag => 'h5', sub { $_[0]->as_text eq 'Genre:' } );
|
||||
|
||||
if( $genre_title )
|
||||
{
|
||||
my @genres = $genre_title->right;
|
||||
pop @genres; #Remove the "more.." link.
|
||||
|
||||
if( @genres )
|
||||
{
|
||||
$self->{data}->{genre} .= (ref $_ ? $_->as_text : $_) for @genres;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub get_plotsummary
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
|
||||
my $first_summary = $tree->look_down( _tag => 'p', class => 'plotpar' );
|
||||
if( $first_summary )
|
||||
{
|
||||
$self->{data}->{summary} = $first_summary->as_text;
|
||||
}
|
||||
}
|
||||
|
||||
sub get_quotes
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
|
||||
my $first_link = $tree->look_down( _tag => "a", name => qr/qt\d+/ );
|
||||
return unless $first_link;
|
||||
my @quote_eles = ($first_link,$first_link->right);
|
||||
|
||||
my $quotes;
|
||||
|
||||
for( my $i = 0; $i < $#quote_eles; $i++ )
|
||||
{
|
||||
local $_ = $quote_eles[$i];
|
||||
|
||||
if( ref $_ and $_->tag eq 'a' and $_->attr('name') =~ /qt\d+/ )
|
||||
{
|
||||
my @quote;
|
||||
|
||||
my $start = $i;
|
||||
for( $i; $i < @quote_eles; $i++ )
|
||||
{
|
||||
local $_ = $quote_eles[$i];
|
||||
|
||||
if( ref $_ and ( $_->tag eq 'hr' or $_->tag eq 'div' ) )
|
||||
{
|
||||
last;
|
||||
}
|
||||
|
||||
if( ref $_ and $_->tag eq 'i' )
|
||||
{
|
||||
$quote[-1] .= $_->as_text;
|
||||
$i++;
|
||||
#Hrm, this should probably always be plain text..
|
||||
$quote[-1] .= ref $quote_eles[$i] ? $quote_eles[$i]->as_text : $quote_eles[$i];
|
||||
}
|
||||
else
|
||||
{
|
||||
my $str = ref $_ ? $_->as_text : $_;
|
||||
if( $str =~ /\S/ ) { push @quote, $str }
|
||||
}
|
||||
}
|
||||
|
||||
for( my $j = 0; $j < @quote; $j++ )
|
||||
{
|
||||
if( $quote[$j] =~ /:/ )
|
||||
{
|
||||
$quote[$j-1].=$quote[$j];
|
||||
$quote[$j]='';
|
||||
}
|
||||
}
|
||||
|
||||
s/^\s+//,s/\s+$// for @quote;
|
||||
@quote = grep length $_, @quote;
|
||||
push @$quotes, \@quote;
|
||||
}
|
||||
}
|
||||
|
||||
$self->{data}->{quotes} = $quotes;
|
||||
}
|
||||
|
||||
sub get_trivia
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
|
||||
my @trivia;
|
||||
for my $ul ($tree->look_down( _tag => "ul", class => "trivia" ) )
|
||||
{
|
||||
for( $ul->look_down( _tag => "li" ) )
|
||||
{
|
||||
push @trivia, $_->as_text;
|
||||
}
|
||||
}
|
||||
|
||||
$self->{data}->{trivia} = \@trivia;
|
||||
}
|
||||
|
||||
sub get_fullcredits
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
}
|
||||
|
||||
1;
|
||||
241
deps/IMDB/lib/IMDB.pm
vendored
241
deps/IMDB/lib/IMDB.pm
vendored
|
|
@ -1,241 +0,0 @@
|
|||
package IMDB;
|
||||
use HTML::TreeBuilder;
|
||||
use URI;
|
||||
use LWP::Simple qw/get/;
|
||||
use URI::Escape qw/uri_escape/;
|
||||
use strict;
|
||||
|
||||
|
||||
sub normalize_title
|
||||
{
|
||||
my( $self, $title ) = @_;
|
||||
|
||||
$title =~ tr/'"[]//d;
|
||||
$title =~ s/ +/ /g;
|
||||
return $title;
|
||||
}
|
||||
|
||||
sub new
|
||||
{
|
||||
my( $class, $title ) = @_;
|
||||
my $self = bless {}, $class;
|
||||
|
||||
my ($uri,$tree) = $self->search( $title );
|
||||
return unless defined $tree;
|
||||
|
||||
$self->get_title($tree);
|
||||
$self->get_basic_info($tree);
|
||||
|
||||
for( qw/plotsummary fullcredits trivia quotes/ )
|
||||
{
|
||||
warn "Fetching $uri$_\n";
|
||||
my $html = get( "$uri$_" );
|
||||
my $tree = HTML::TreeBuilder->new;
|
||||
$tree->parse($html);
|
||||
$tree->eof;
|
||||
|
||||
my $method_name = "get_$_";
|
||||
$self->$method_name($tree);
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub search
|
||||
{
|
||||
my( $self, $title ) = @_;
|
||||
my $search_uri = "http://www.imdb.com/find?s=all&q=" . uri_escape($self->normalize_title($title));
|
||||
warn "Fetching $search_uri\n";
|
||||
my $html = get($search_uri);
|
||||
|
||||
my $tree = HTML::TreeBuilder->new;
|
||||
$tree->parse($html);
|
||||
$tree->eof;
|
||||
|
||||
if( not $tree->look_down(_tag => "title")->as_text =~ /IMDb.*Search/ )
|
||||
{
|
||||
my $link = $tree->look_down( _tag => 'a', href => qr#/title/tt# );
|
||||
$link->attr('href') =~ m'(/title/tt\d+)';
|
||||
return ( "http://www.imdb.com$1",$tree );
|
||||
}
|
||||
|
||||
#This gets the initial header for the search results. <h2>Popular Results</h2>
|
||||
my $top_ele = $tree->look_down( _tag => 'b', sub { $_[0]->as_text eq 'Popular Titles' } );
|
||||
|
||||
if( $top_ele and ($top_ele->parent->content_list)[2] )
|
||||
{
|
||||
$top_ele = ($top_ele->parent->content_list)[2]; #Should be the opening tag for the follow list of links.
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
$top_ele = $tree->look_down( _tag => 'b', sub { $_[0]->as_text eq 'Titles (Exact Matches)' } );
|
||||
|
||||
if( $top_ele )
|
||||
{
|
||||
$top_ele = ($top_ele->right)[1];
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
$top_ele = $tree->look_down( _tag => 'b', sub { $_[0]->as_text eq 'Titles (Approx Matches)' } );
|
||||
|
||||
if( $top_ele )
|
||||
{
|
||||
$top_ele = ($top_ele->right)[1];
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
$top_ele = $tree->look_down( _tag => 'b', sub { $_[0]->as_text eq 'Titles (Partial Matches)' } );
|
||||
|
||||
if( $top_ele )
|
||||
{
|
||||
$top_ele = ($top_ele->right)[1];
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
warn "Error, could not find a useful result for term $title\n";
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# warn "Top ele -- ", $top_ele->as_HTML;
|
||||
|
||||
my $first_link = $top_ele->look_down( _tag => 'a' ); #We only want the first link anyway.
|
||||
|
||||
my $path = URI->new($first_link->attr('href'))->path;
|
||||
my $uri = URI->new_abs( $path, "http://imdb.com");
|
||||
$self->{data}->{uri} = $uri;
|
||||
|
||||
my $actual_html = get( $uri );
|
||||
my $new_tree = HTML::TreeBuilder->new;
|
||||
$new_tree->parse($actual_html);
|
||||
return ($uri,$new_tree);
|
||||
}
|
||||
|
||||
|
||||
sub get_title
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
|
||||
my $title = $tree->look_down(_tag => "title");
|
||||
$self->{data}->{title} = $title->as_text if $title;
|
||||
}
|
||||
|
||||
sub get_basic_info
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
|
||||
my $rdate = $tree->look_down( _tag => 'h5', sub { $_[0]->as_text eq 'Release Date:' } );
|
||||
$self->{data}->{release_date} = $rdate->right if $rdate;
|
||||
my $genre_title = $tree->look_down( _tag => 'h5', sub { $_[0]->as_text eq 'Genre:' } );
|
||||
|
||||
if( $genre_title )
|
||||
{
|
||||
my @genres = $genre_title->right;
|
||||
pop @genres; #Remove the "more.." link.
|
||||
|
||||
if( @genres )
|
||||
{
|
||||
$self->{data}->{genre} .= (ref $_ ? $_->as_text : $_) for @genres;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub get_plotsummary
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
|
||||
my $first_summary = $tree->look_down( _tag => 'p', class => 'plotpar' );
|
||||
if( $first_summary )
|
||||
{
|
||||
$self->{data}->{summary} = $first_summary->as_text;
|
||||
}
|
||||
}
|
||||
|
||||
sub get_quotes
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
|
||||
my $first_link = $tree->look_down( _tag => "a", name => qr/qt\d+/ );
|
||||
return unless $first_link;
|
||||
my @quote_eles = ($first_link,$first_link->right);
|
||||
|
||||
my $quotes;
|
||||
|
||||
for( my $i = 0; $i < $#quote_eles; $i++ )
|
||||
{
|
||||
local $_ = $quote_eles[$i];
|
||||
|
||||
if( ref $_ and $_->tag eq 'a' and $_->attr('name') =~ /qt\d+/ )
|
||||
{
|
||||
my @quote;
|
||||
|
||||
my $start = $i;
|
||||
for( $i; $i < @quote_eles; $i++ )
|
||||
{
|
||||
local $_ = $quote_eles[$i];
|
||||
|
||||
if( ref $_ and ( $_->tag eq 'hr' or $_->tag eq 'div' ) )
|
||||
{
|
||||
last;
|
||||
}
|
||||
|
||||
if( ref $_ and $_->tag eq 'i' )
|
||||
{
|
||||
$quote[-1] .= $_->as_text;
|
||||
$i++;
|
||||
#Hrm, this should probably always be plain text..
|
||||
$quote[-1] .= ref $quote_eles[$i] ? $quote_eles[$i]->as_text : $quote_eles[$i];
|
||||
}
|
||||
else
|
||||
{
|
||||
my $str = ref $_ ? $_->as_text : $_;
|
||||
if( $str =~ /\S/ ) { push @quote, $str }
|
||||
}
|
||||
}
|
||||
|
||||
for( my $j = 0; $j < @quote; $j++ )
|
||||
{
|
||||
if( $quote[$j] =~ /:/ )
|
||||
{
|
||||
$quote[$j-1].=$quote[$j];
|
||||
$quote[$j]='';
|
||||
}
|
||||
}
|
||||
|
||||
s/^\s+//,s/\s+$// for @quote;
|
||||
@quote = grep length $_, @quote;
|
||||
push @$quotes, \@quote;
|
||||
}
|
||||
}
|
||||
|
||||
$self->{data}->{quotes} = $quotes;
|
||||
}
|
||||
|
||||
sub get_trivia
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
|
||||
my @trivia;
|
||||
for my $ul ($tree->look_down( _tag => "ul", class => "trivia" ) )
|
||||
{
|
||||
for( $ul->look_down( _tag => "li" ) )
|
||||
{
|
||||
push @trivia, $_->as_text;
|
||||
}
|
||||
}
|
||||
|
||||
$self->{data}->{trivia} = \@trivia;
|
||||
}
|
||||
|
||||
sub get_fullcredits
|
||||
{
|
||||
my( $self, $tree ) = @_;
|
||||
}
|
||||
|
||||
1;
|
||||
62
deps/IMDB/t/.svn/entries
vendored
62
deps/IMDB/t/.svn/entries
vendored
|
|
@ -1,62 +0,0 @@
|
|||
10
|
||||
|
||||
dir
|
||||
475
|
||||
svn://erxz.com/bb3/branches/perlbuut/deps/IMDB/t
|
||||
svn://erxz.com/bb3
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
dcb1cea6-7f7e-4c78-8a22-148ace8ce36e
|
||||
|
||||
IMDB.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
5563f424f7940616770262ffdd161ce7
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
495
|
||||
|
||||
17
deps/IMDB/t/.svn/text-base/IMDB.t.svn-base
vendored
17
deps/IMDB/t/.svn/text-base/IMDB.t.svn-base
vendored
|
|
@ -1,17 +0,0 @@
|
|||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl IMDB.t'
|
||||
|
||||
#########################
|
||||
|
||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
|
||||
use Test;
|
||||
BEGIN { plan tests => 1 };
|
||||
use IMDB;
|
||||
ok(1); # If we made it this far, we're ok.
|
||||
|
||||
#########################
|
||||
|
||||
# Insert your test code below, the Test::More module is use()ed here so read
|
||||
# its man page ( perldoc Test::More ) for help writing this test script.
|
||||
|
||||
17
deps/IMDB/t/IMDB.t
vendored
17
deps/IMDB/t/IMDB.t
vendored
|
|
@ -1,17 +0,0 @@
|
|||
# Before `make install' is performed this script should be runnable with
|
||||
# `make test'. After `make install' it should work as `perl IMDB.t'
|
||||
|
||||
#########################
|
||||
|
||||
# change 'tests => 1' to 'tests => last_test_to_print';
|
||||
|
||||
use Test;
|
||||
BEGIN { plan tests => 1 };
|
||||
use IMDB;
|
||||
ok(1); # If we made it this far, we're ok.
|
||||
|
||||
#########################
|
||||
|
||||
# Insert your test code below, the Test::More module is use()ed here so read
|
||||
# its man page ( perldoc Test::More ) for help writing this test script.
|
||||
|
||||
|
|
@ -1,408 +0,0 @@
|
|||
10
|
||||
|
||||
dir
|
||||
475
|
||||
svn://erxz.com/bb3/branches/perlbuut/deps/JavaScript-SpiderMonkey-0.19-patched
|
||||
svn://erxz.com/bb3
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
dcb1cea6-7f7e-4c78-8a22-148ace8ce36e
|
||||
|
||||
SpiderMonkey.h
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
9f9edd285dd69ea755e8cf82d2895988
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
311
|
||||
|
||||
typemap
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
0b4b207f9bceddce222c490f7833f85c
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
580
|
||||
|
||||
SpiderMonkey.xs
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
3cdf4e44832e756fd6fd56caccfc34c1
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
22143
|
||||
|
||||
t
|
||||
dir
|
||||
|
||||
SpiderMonkey.pm
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
86c0e5aaf190279dbcccf8bca20fd853
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
20317
|
||||
|
||||
INSTALL
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
61bdc79780049dfac7ccb8e934494ca8
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
809
|
||||
|
||||
MANIFEST
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
91b8f16b9e54c3289a60d9dfb0de7f67
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
490
|
||||
|
||||
META.yml
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
e3947fa5d8ade1061c359b694a6dfa83
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
484
|
||||
|
||||
Makefile.PL
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
687a07196bd2f9d9a768fb57c9594ec9
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
4581
|
||||
|
||||
Changes
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
d7e46aa4fd49100848e5c27a0f8bcd06
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
3286
|
||||
|
||||
MANIFEST.SKIP
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
9110b82363ff8e3e369493cda15d5ca8
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
128
|
||||
|
||||
util
|
||||
dir
|
||||
|
||||
README
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
549447c180c59658f370b25d50a30666
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
7770
|
||||
|
||||
|
|
@ -1,94 +0,0 @@
|
|||
Revision history for Perl extension JavaScript::SpiderMonkey.
|
||||
|
||||
0.19 (05/09/2007)
|
||||
(tb) Allocate correct amount of memory for scripts that contain UTF-8
|
||||
characters with internal UTF-8 flag on.
|
||||
|
||||
0.18 (08/06/2007)
|
||||
(tb) Added protection against infinite loops
|
||||
(tb) Added support for JS_THREADSAFE
|
||||
|
||||
0.17 (27/07/2006)
|
||||
(tb) Made sure eval function doesn't produce warnings when script
|
||||
variable is uninitialized.
|
||||
[was supposed to be part of 0.16 but is actually part of 0.17]
|
||||
(tb) Added support for E4X
|
||||
|
||||
0.16 (13/06/2006)
|
||||
(tb) Added patch initially proposed by marc [at] igneousconsulting.com
|
||||
and subsequently modified by Agent Zhang that allows mapped perl
|
||||
functions to return varied datatypes back to JavaScript
|
||||
|
||||
0.15 (28/02/2006)
|
||||
(tb) Rewrote Makefile.PL to work on more platforms
|
||||
|
||||
0.14 (12/02/2006)
|
||||
(tb) Removed remaining debug info
|
||||
|
||||
0.13 (05/02/2006)
|
||||
(tb) Removed debug info
|
||||
(tb) Made sure Makefile.PL finds libjs if installed in /usr/lib or
|
||||
/usr/local/lib
|
||||
|
||||
0.12 (12/03/2005)
|
||||
(ms) Makefile.PL prerequisite changed from undef to '0'.
|
||||
(ms) Thomas Busch added a check to Makefile.PL to find an already
|
||||
installed JS lib.
|
||||
|
||||
0.11 (08/22/2004)
|
||||
* (ms) Added Log::Log4perl dependency in Makefile.PL as suggested
|
||||
by an anonymous posting on rt.cpan.org.
|
||||
* (ms) Added #define for MSC compiler as suggested in
|
||||
https://rt.cpan.org/Ticket/Display.html?id=6984
|
||||
* (ms) Roger Crew <crew@cs.stanford.edu> provided patches for
|
||||
a clean Win32 compile plus README text on installing the dll/so.
|
||||
|
||||
0.10 06/20/2004
|
||||
* Nikita Savin <nikita@savin.go2serve.net> provided a patch to
|
||||
set $@ instead of printing to STDERR in case of a JS error.
|
||||
* Added patch by Chris Blaise <cblaise@esoft.com>:
|
||||
- Different objects can have the same named function. If no
|
||||
object is specified on function_set, it's global.
|
||||
* Log4perl in for debugging
|
||||
* Chris Blaise submitted a patch to have a perl callback return
|
||||
an object to JS. Applied with modifications, longer term we need
|
||||
a solution on how the perl callback tells the JS wrapper what's coming
|
||||
back: A JS string, an object or an integer.
|
||||
|
||||
0.09 02/20/2004
|
||||
* Max Maischein added Win32 installation steps in Makefile.PL
|
||||
|
||||
0.08 09/19/2002
|
||||
* Doc bug fixed, reported by Yoz Grahame.
|
||||
|
||||
0.07 09/14/2002
|
||||
* Release mgmt changed
|
||||
|
||||
0.06 07/10/2002
|
||||
* Made M*PL smarter to detect the JS target platform
|
||||
|
||||
0.05 06/23/2002
|
||||
* Added installation instructions to README.
|
||||
|
||||
0.04 06/23/2002
|
||||
* Added test case for just setter or just getter
|
||||
* Added documentation
|
||||
* Updated todo list
|
||||
|
||||
0.03 06/23/2002
|
||||
* Added setters and getters for properties
|
||||
|
||||
0.02 01/20/2002
|
||||
* Fixed properties (get/set)
|
||||
|
||||
0.01 01/03/2002
|
||||
* Where it all began.
|
||||
|
||||
TODO:
|
||||
* setters/getters for arrays
|
||||
* Get rid of GLOBAL and the limitation to one instance
|
||||
* getter/setter called every time, callback settings checked
|
||||
at perl level only
|
||||
* Make fixed constants in init() configurable (1000000)
|
||||
* Allow for different contexts
|
||||
* Rethink function names (by_path, function_set etc.)
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
|
||||
How to install JavaScript::SpiderMonkey
|
||||
|
||||
Get the latest SpiderMonkey distribution from mozilla.org:
|
||||
http://www.mozilla.org/js/spidermonkey shows which releases are available.
|
||||
http://ftp.mozilla.org/pub/js/js-1.5-rc3a.tar.gz has been proven to work.
|
||||
|
||||
Untar it at the same directory level as the distribution of the
|
||||
JavaScript::SpiderMonkey perl module distribution whichs README
|
||||
you're currently reading:
|
||||
|
||||
cd ..
|
||||
tar zxfv js-1.5-rc3a.tar.gz
|
||||
|
||||
It's important that the js and JavaScript-SpiderMonkey-v.vv directories
|
||||
are at the same level:
|
||||
|
||||
$ls
|
||||
JavaScript-SpiderMonkey-1.00
|
||||
js
|
||||
js-1.5-rc3a.tar.gz
|
||||
|
||||
Now, build JavaScript::SpiderMonkey in the standard way:
|
||||
|
||||
cd JavaScript-SpiderMonkey-1.00
|
||||
perl Makefile.PL
|
||||
gmake
|
||||
gmake test
|
||||
gmake install
|
||||
|
||||
-- and you're good to go! Have fun.
|
||||
|
||||
Mike Schilli, m@perlmeister.com, 2002
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
blib
|
||||
^Makefile$
|
||||
^Makefile.old$
|
||||
CVS
|
||||
.cvsignore
|
||||
docs
|
||||
MANIFEST.bak
|
||||
adm/release
|
||||
^SpiderMonkey.bs$
|
||||
^SpiderMonkey.c$
|
||||
^SpiderMonkey.o$
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
Changes
|
||||
INSTALL
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
MANIFEST.SKIP
|
||||
META.yml Module meta-data (added by MakeMaker)
|
||||
README
|
||||
SpiderMonkey.pm
|
||||
SpiderMonkey.xs
|
||||
SpiderMonkey.h
|
||||
t/000readme.t
|
||||
t/001properties.t
|
||||
t/002functions.t
|
||||
t/003properties.t
|
||||
t/004setget.t
|
||||
t/005error.t
|
||||
t/006objmeth.t
|
||||
t/007funcret.t
|
||||
t/00array.t
|
||||
t/01doc-href.t
|
||||
t/02nav-appv.t
|
||||
t/03doc-write.t
|
||||
t/04loop.t
|
||||
t/05form.t
|
||||
t/06form2.t
|
||||
t/07func.t
|
||||
t/08func2.t
|
||||
t/09meth.t
|
||||
t/10elobj.t
|
||||
t/11intret.t
|
||||
t/12dblret.t
|
||||
t/13strret.t
|
||||
t/init.pl
|
||||
typemap
|
||||
util/download.pl
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
--- #YAML:1.0
|
||||
name: JavaScript-SpiderMonkey
|
||||
version: 0.19
|
||||
abstract: Perl interface to the JavaScript Engine
|
||||
license: ~
|
||||
generated_by: ExtUtils::MakeMaker version 6.36
|
||||
distribution_type: module
|
||||
requires:
|
||||
Data::Dumper: 0
|
||||
Log::Log4perl: 0
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
||||
version: 1.2
|
||||
author:
|
||||
- Mike Schilli <m@perlmeister.com>
|
||||
|
|
@ -1,166 +0,0 @@
|
|||
######################################################################
|
||||
#
|
||||
# MakeMaker file for JavaScript::SpiderMonkey
|
||||
#
|
||||
# Revision: $Revision: 1.5 $
|
||||
# Last Checkin: $Date: 2007/06/08 19:03:08 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Authors: Mike Schilli m@perlmeister.com, 2002-2005
|
||||
# Thomas Busch tbusch@cpan.org, 2006
|
||||
#
|
||||
######################################################################
|
||||
|
||||
use ExtUtils::MakeMaker;
|
||||
use Getopt::Long;
|
||||
|
||||
# Get the right lib and include dirs for different platforms
|
||||
|
||||
my $JS_LIB_DIR;
|
||||
my @JS_INCL_DIRS;
|
||||
|
||||
my @c_header_files = qw(
|
||||
jsapi.h
|
||||
jsautocfg.h
|
||||
);
|
||||
|
||||
my @possible_libraries = qw(
|
||||
libjs.a
|
||||
js32.dll
|
||||
libmozjs.so
|
||||
);
|
||||
|
||||
my %possible_install_paths = (
|
||||
"../js/src/*" => "../js/src",
|
||||
"/usr/lib" => "/usr/include",
|
||||
"/usr/local/lib" => "/usr/local/include",
|
||||
"/usr/lib/firefox" => "/usr/include/firefox",
|
||||
);
|
||||
|
||||
my ($JS_LIB_DIR, @JS_INCL_DIRS, $JS_LIB_NAME);
|
||||
|
||||
foreach my $install_path(keys %possible_install_paths) {
|
||||
foreach my $possible_lib(@possible_libraries) {
|
||||
foreach my $libfile(glob "$install_path/$possible_lib") {
|
||||
next if ! -f $libfile;
|
||||
my $include_path = $possible_install_paths{$install_path};
|
||||
foreach my $c_header(@c_header_files) {
|
||||
if (-f "$include_path/$c_header") {
|
||||
my $include_dir = "$include_path/$c_header";
|
||||
$include_dir =~ s/$c_header$//;
|
||||
push @JS_INCL_DIRS, $include_dir;
|
||||
}
|
||||
foreach my $headerfile(glob "$include_path/*/$c_header") {
|
||||
my $include_dir = $headerfile;
|
||||
$include_dir =~ s/$c_header$//;
|
||||
push @JS_INCL_DIRS, $include_dir;
|
||||
}
|
||||
}
|
||||
if (scalar(@JS_INCL_DIRS) == scalar(@c_header_files)) {
|
||||
$JS_LIB_DIR = $libfile;
|
||||
$JS_LIB_DIR =~ s/$possible_lib$//;
|
||||
|
||||
$JS_LIB_NAME = $possible_lib;
|
||||
$JS_LIB_NAME =~ s/\.(a|so|dll)$//;
|
||||
$JS_LIB_NAME =~ s/^lib//;
|
||||
|
||||
last;
|
||||
} else {
|
||||
@JS_INCL_DIRS = ();
|
||||
}
|
||||
}
|
||||
last if $JS_LIB_DIR;
|
||||
}
|
||||
last if $JS_LIB_DIR;
|
||||
}
|
||||
|
||||
if ($JS_INCL_DIRS[0] eq $JS_INCL_DIRS[1]) {
|
||||
shift @JS_INCL_DIRS;
|
||||
}
|
||||
|
||||
## If no SpiderMonkey library found report that and exit.
|
||||
## Otherwise print lib and include paths.
|
||||
|
||||
if (!$JS_LIB_DIR) {
|
||||
print <<EOT;
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
This module requires the SpiderMonkey C library -- please read the
|
||||
README file on how to download, compile and link it.
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
EOT
|
||||
exit 0;
|
||||
} else {
|
||||
print "JS_LIB_DIR: $JS_LIB_DIR\n";
|
||||
foreach my $include_dir(@JS_INCL_DIRS) {
|
||||
print "JS_INCL_DIR: $include_dir\n";
|
||||
}
|
||||
print "JS_LIB_NAME: $JS_LIB_NAME\n";
|
||||
}
|
||||
|
||||
#### Determine compile options
|
||||
##############################
|
||||
|
||||
my $JS_DEFINE;
|
||||
my $E4X = 0;
|
||||
my $JS_THREADSAFE = 0;
|
||||
|
||||
## Get options from command line
|
||||
GetOptions(
|
||||
"E4X" => \$E4X,
|
||||
"JS_THREADSAFE" => \$JS_THREADSAFE,
|
||||
);
|
||||
|
||||
|
||||
## Determine library name and system-related defines
|
||||
if ($^O ne 'MSWin32') {
|
||||
$JS_DEFINE = '-DXP_UNIX';
|
||||
} else {
|
||||
$JS_DEFINE = '-DXP_WIN';
|
||||
};
|
||||
|
||||
## Add E4X support if flag set.
|
||||
## For more info about E4X check http://en.wikipedia.org/wiki/E4X
|
||||
if ($E4X) {
|
||||
$JS_DEFINE .= " -DE4X";
|
||||
print "E4X support enabled\n";
|
||||
}
|
||||
|
||||
## Support compiling in thread safe environment
|
||||
if ($JS_THREADSAFE) {
|
||||
$JS_DEFINE .= " -DJS_THREADSAFE";
|
||||
print "Compiling with JS_THREADSAFE flag\n";
|
||||
}
|
||||
|
||||
|
||||
#### See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
#### the contents of the Makefile that is written.
|
||||
##################################################
|
||||
|
||||
WriteMakefile(
|
||||
'NAME' => 'JavaScript::SpiderMonkey',
|
||||
'VERSION_FROM' => 'SpiderMonkey.pm', # finds $VERSION
|
||||
'PREREQ_PM' => {
|
||||
'Log::Log4perl' => 0,
|
||||
'Data::Dumper' => 0,
|
||||
}, # e.g., Module::Name => 1.1
|
||||
($] >= 5.005 ? ## Add these new keywords supported since 5.005
|
||||
(ABSTRACT_FROM => 'SpiderMonkey.pm', # retrieve abstract from module
|
||||
AUTHOR => 'Mike Schilli <m@perlmeister.com>') : ()),
|
||||
'LIBS' => ["-L$JS_LIB_DIR -l$JS_LIB_NAME"], # e.g., '-lm'
|
||||
'DEFINE' => $JS_DEFINE, # e.g., '-DHAVE_SOMETHING'
|
||||
# Insert -I. if you add *.h files later:
|
||||
'INC' => "-I".join " -I", @JS_INCL_DIRS,
|
||||
# Un-comment this if you add C files to link with later:
|
||||
# 'OBJECT' => '$(O_FILES)', # link all the C files too
|
||||
);
|
||||
|
||||
######################################################################
|
||||
sub MY::postamble {
|
||||
######################################################################
|
||||
'
|
||||
README: SpiderMonkey.pm
|
||||
pod2text SpiderMonkey.pm >README
|
||||
';
|
||||
}
|
||||
|
|
@ -1,211 +0,0 @@
|
|||
######################################################################
|
||||
JavaScript::SpiderMonkey 0.17
|
||||
######################################################################
|
||||
|
||||
NAME
|
||||
JavaScript::SpiderMonkey - Perl interface to the JavaScript Engine
|
||||
|
||||
SYNOPSIS
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
|
||||
$js->init(); # Initialize Runtime/Context
|
||||
|
||||
# Define a perl callback for a new JavaScript function
|
||||
$js->function_set("print_to_perl", sub { print "@_\n"; });
|
||||
|
||||
# Create a new (nested) object and a property
|
||||
$js->property_by_path("document.location.href");
|
||||
|
||||
# Execute some code
|
||||
my $rc = $js->eval(q!
|
||||
document.location.href = append("http://", "www.aol.com");
|
||||
|
||||
print_to_perl("URL is ", document.location.href);
|
||||
|
||||
function append(first, second) {
|
||||
return first + second;
|
||||
}
|
||||
!);
|
||||
|
||||
# Get the value of a property set in JS
|
||||
my $url = $js->property_get("document.location.href");
|
||||
|
||||
$js->destroy();
|
||||
|
||||
INSTALL
|
||||
JavaScript::SpiderMonkey requires Mozilla's readily compiled
|
||||
SpiderMonkey 1.5 distribution or better. Please check "SpiderMonkey
|
||||
Installation".
|
||||
|
||||
DESCRIPTION
|
||||
JavaScript::SpiderMonkey is a Perl Interface to the SpiderMonkey
|
||||
JavaScript Engine. It is different from Claes Jacobsson's
|
||||
"JavaScript.pm" in that it offers two different levels of access:
|
||||
|
||||
[1] A 1:1 mapping of the SpiderMonkey API to Perl
|
||||
|
||||
[2] A more Perl-like API
|
||||
|
||||
This document describes [2], for [1], please check "SpiderMonkey.xs".
|
||||
|
||||
new()
|
||||
"$js = JavaScript::SpiderMonkey->new()" creates a new object to work
|
||||
with. To initialize the JS runtime, call "$js->init()" afterwards.
|
||||
|
||||
$js->destroy()
|
||||
"$js->destroy()" destroys the current runtime and frees up all memory.
|
||||
|
||||
$js->init()
|
||||
"$js->init()" initializes the SpiderMonkey engine by creating a context,
|
||||
default classes and objects and adding an error reporter.
|
||||
|
||||
$js->array_by_path($name)
|
||||
Creates an object of type *Array* in the JS runtime:
|
||||
|
||||
$js->array_by_path("document.form");
|
||||
|
||||
will first create an object with the name "document" (unless it exists
|
||||
already) and then define a property named "form" to it, which is an
|
||||
object of type *Array*. Therefore, in the JS code, you're going to be
|
||||
able define things like
|
||||
|
||||
document.form[0] = "value";
|
||||
|
||||
$js->function_set($name, $funcref, [$obj])
|
||||
Binds a Perl function provided as a coderef ($funcref) to a newly
|
||||
created JS function named $name in JS land. It's a real function
|
||||
(therefore bound to the global object) if $obj is omitted. However, if
|
||||
$obj is ref to a JS object (retrieved via "$js->object_by_path($path)"
|
||||
or the like), the function will be a *method* of the specified object.
|
||||
|
||||
$js->function_set("write", sub { print @_ });
|
||||
# write("hello"); // In JS land
|
||||
|
||||
$obj = $j->object_by_path("navigator");
|
||||
$js->function_set("write", sub { print @_ }, $obj);
|
||||
# navigator.write("hello"); // In JS land
|
||||
|
||||
$js->array_set_element($obj, $idx, $val)
|
||||
Sets the element of the array $obj at index position $idx to the value
|
||||
$val. $obj is a reference to an object of type array (retrieved via
|
||||
"$js->object_by_path($path)" or the like).
|
||||
|
||||
$js->array_set_element_as_object($obj, $idx, $elobj)
|
||||
Sets the element of the array $obj at index position $idx to the object
|
||||
$elobj (both $obj and $elobj have been retrieved via
|
||||
"$js->object_by_path($path)" or the like).
|
||||
|
||||
$js->array_get_element($obj, $idx)
|
||||
Gets the value of of the element at index $idx of the object of type
|
||||
Array $obj.
|
||||
|
||||
$js->property_by_path($path, $value, [$getter], [$setter])
|
||||
Sets the specified property of an object in $path to the value $value.
|
||||
$path is the full name of the property, including the object(s) in JS
|
||||
land it belongs to:
|
||||
|
||||
$js-E<gt>property_by_path("document.location.href", "abc");
|
||||
|
||||
This first creates the object "document" (if it doesn't exist already),
|
||||
then the object "document.location", then attaches the property "href"
|
||||
to it and sets it to "abc".
|
||||
|
||||
$getter and $setter are coderefs that will be called by the JavaScript
|
||||
engine when the respective property's value is requested or set:
|
||||
|
||||
sub getter {
|
||||
my($property_path, $value) = @_;
|
||||
print "$property_path has value $value\n";
|
||||
}
|
||||
|
||||
sub setter {
|
||||
my($property_path, $value) = @_;
|
||||
print "$property_path set to value $value\n";
|
||||
}
|
||||
|
||||
$js-E<gt>property_by_path("document.location.href", "abc",
|
||||
\&getter, \&setter);
|
||||
|
||||
If you leave out $getter and $setter, there's going to be no callbacks
|
||||
triggerd while the properity is set or queried. If you just want to
|
||||
specify a $setter, but no $getter, set the $getter to "undef".
|
||||
|
||||
$js->object_by_path($path, [$newobj])
|
||||
Get a pointer to an object with the path specified. Create it if it's
|
||||
not there yet. If $newobj is provided, the ref is used to bind the
|
||||
existing object to the name in $path.
|
||||
|
||||
$js->property_get($path)
|
||||
Fetch the property specified by the $path.
|
||||
|
||||
my $val = $js->property_get("document.location.href");
|
||||
|
||||
$js->eval($code)
|
||||
Runs the specified piece of <$code> in the JS engine. Afterwards,
|
||||
property values of objects previously defined will be available via
|
||||
"$j->property_get($path)" and the like.
|
||||
|
||||
my $rc = $js->eval("write('hello');");
|
||||
|
||||
The method returns 1 on success or else if there was an error in JS
|
||||
land. In case of an error, the JS error text will be available in $@.
|
||||
|
||||
SpiderMonkey Installation
|
||||
First, get the latest SpiderMonkey distribution from mozilla.org:
|
||||
http://www.mozilla.org/js/spidermonkey shows which releases are
|
||||
available. "js-1.5-rc3a.tar.gz" has been proven to work.
|
||||
|
||||
Untar it at the same directory level as you just untarred the
|
||||
"JavaScript::SpiderMonkey" distribution you're currently reading. So, if
|
||||
you're currently in "/my/path/JavaScript-SpiderMonkey-v.vv", do this:
|
||||
|
||||
cp js-1.5-rc3a.tar.gz /my/path
|
||||
cd /my/path
|
||||
tar zxfv js-1.5-rc3a.tar.gz
|
||||
|
||||
Then, compile the SpiderMonkey distribution, if you're on Linux, just
|
||||
use:
|
||||
|
||||
cd js/src
|
||||
make -f Makefile.ref
|
||||
|
||||
It's important that the js and JavaScript-SpiderMonkey-v.vv directories
|
||||
are at the same level:
|
||||
|
||||
[/my/path]$ ls
|
||||
JavaScript-SpiderMonkey-v.vv
|
||||
js
|
||||
js-1.5-rc3a.tar.gz
|
||||
[/my/path]$
|
||||
|
||||
(Note that you *can* untar the SpiderMonkey distribution elsewhere, but,
|
||||
if so, then you need to edit the setting of $JSLIBPATH in Makefile.PL).
|
||||
|
||||
Next, you need to copy the shared library file thus constructed (e.g.,
|
||||
libjs.so or js32.dll) to an appropriate directory on your library path.
|
||||
On Windows, this can also be the directory where the perl executable
|
||||
lives. On Unix, this has been shown to work without copying, but this
|
||||
way you need to keep the compiled binary in the "js" build directory
|
||||
forever. Copying "js/src/Your_OS_DBG.OBJ/libjs.so" to "/usr/local/lib"
|
||||
and making sure that "/usr/local/lib" is in your "LD_LIBRARY_PATH" seems
|
||||
to be safest bet.
|
||||
|
||||
Now, build JavaScript::SpiderMonkey in the standard way:
|
||||
|
||||
cd JavaScript-SpiderMonkey-v.vv
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
AUTHOR
|
||||
Mike Schilli, <m@perlmeister.com>
|
||||
|
||||
COPYRIGHT AND LICENSE
|
||||
Copyright 2002 by Mike Schilli
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
|
||||
/* Strucuture that keeps track of contexts */
|
||||
struct PJS_Context {
|
||||
/* total number of branch_operations the runtime went through in this context */
|
||||
int branch_count;
|
||||
|
||||
/* max number of branch_operations allowed in this context */
|
||||
int branch_max;
|
||||
};
|
||||
|
||||
typedef struct PJS_Context PJS_Context;
|
||||
|
||||
|
|
@ -1,707 +0,0 @@
|
|||
######################################################################
|
||||
package JavaScript::SpiderMonkey;
|
||||
######################################################################
|
||||
# Revision: $Revision: 1.8 $
|
||||
# Last Checkin: $Date: 2007/09/05 12:00:17 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
=head1 NAME
|
||||
|
||||
JavaScript::SpiderMonkey - Perl interface to the JavaScript Engine
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
|
||||
$js->init(); # Initialize Runtime/Context
|
||||
|
||||
# Define a perl callback for a new JavaScript function
|
||||
$js->function_set("print_to_perl", sub { print "@_\n"; });
|
||||
|
||||
# Create a new (nested) object and a property
|
||||
$js->property_by_path("document.location.href");
|
||||
|
||||
# Execute some code
|
||||
my $rc = $js->eval(q!
|
||||
document.location.href = append("http://", "www.aol.com");
|
||||
|
||||
print_to_perl("URL is ", document.location.href);
|
||||
|
||||
function append(first, second) {
|
||||
return first + second;
|
||||
}
|
||||
!);
|
||||
|
||||
# Get the value of a property set in JS
|
||||
my $url = $js->property_get("document.location.href");
|
||||
|
||||
$js->destroy();
|
||||
|
||||
=head1 INSTALL
|
||||
|
||||
JavaScript::SpiderMonkey requires Mozilla's readily compiled
|
||||
SpiderMonkey 1.5 distribution or better. Please check
|
||||
L<SpiderMonkey Installation>.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
JavaScript::SpiderMonkey is a Perl Interface to the
|
||||
SpiderMonkey JavaScript Engine. It is different from
|
||||
Claes Jacobsson's C<JavaScript.pm> in that it offers two
|
||||
different levels of access:
|
||||
|
||||
=over 4
|
||||
|
||||
=item [1]
|
||||
|
||||
A 1:1 mapping of the SpiderMonkey API to Perl
|
||||
|
||||
=item [2]
|
||||
|
||||
A more Perl-like API
|
||||
|
||||
=back
|
||||
|
||||
This document describes [2], for [1], please check C<SpiderMonkey.xs>.
|
||||
|
||||
=cut
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Data::Dumper;
|
||||
use Log::Log4perl qw(:easy);
|
||||
|
||||
require Exporter;
|
||||
require DynaLoader;
|
||||
|
||||
our $VERSION = '0.19';
|
||||
our @ISA = qw(Exporter DynaLoader);
|
||||
our %EXPORT_TAGS = ( 'all' => [ qw() ] );
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
our @EXPORT = qw();
|
||||
|
||||
bootstrap JavaScript::SpiderMonkey $VERSION;
|
||||
|
||||
our $GLOBAL;
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 new()
|
||||
|
||||
C<$js = JavaScript::SpiderMonkey-E<gt>new()> creates a new object to work with.
|
||||
To initialize the JS runtime, call C<$js-E<gt>init()> afterwards.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub new {
|
||||
##################################################
|
||||
my ($class) = @_;
|
||||
|
||||
my $self = {
|
||||
'runtime' => undef,
|
||||
'context' => undef,
|
||||
'global_object' => undef,
|
||||
'global_class' => undef,
|
||||
'objects' => { },
|
||||
};
|
||||
|
||||
# The function dispatcher is called from C and
|
||||
# doesn't have 'self'. Store it in a class var.
|
||||
# This means we can only have one instance of this
|
||||
# JavaScript::SpiderMonkey object. Ouch.
|
||||
our $GLOBAL = $self;
|
||||
|
||||
bless $self, $class;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>destroy()
|
||||
|
||||
C<$js-E<gt>destroy()> destroys the current runtime and frees up all memory.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub destroy {
|
||||
##################################################
|
||||
my ($self) = @_;
|
||||
JavaScript::SpiderMonkey::JS_DestroyContext($self->{context});
|
||||
JavaScript::SpiderMonkey::JS_DestroyRuntime($self->{runtime});
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>init()
|
||||
|
||||
C<$js-E<gt>init()> initializes the SpiderMonkey engine by creating a context,
|
||||
default classes and objects and adding an error reporter.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub init {
|
||||
##################################################
|
||||
my ($self) = @_;
|
||||
|
||||
$self->{runtime} =
|
||||
JavaScript::SpiderMonkey::JS_Init(1000000);
|
||||
$self->{context} =
|
||||
JavaScript::SpiderMonkey::JS_NewContext($self->{runtime}, 8192);
|
||||
$self->{global_class} =
|
||||
JavaScript::SpiderMonkey::JS_GlobalClass();
|
||||
$self->{global_object} =
|
||||
JavaScript::SpiderMonkey::JS_NewObject(
|
||||
$self->{context}, $self->{global_class},
|
||||
$self->{global_class}, $self->{global_class});
|
||||
|
||||
JavaScript::SpiderMonkey::JS_InitStandardClasses($self->{context},
|
||||
$self->{global_object});
|
||||
JavaScript::SpiderMonkey::JS_SetErrorReporter($self->{context});
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>array_by_path($name)
|
||||
|
||||
Creates an object of type I<Array>
|
||||
in the JS runtime:
|
||||
|
||||
$js->array_by_path("document.form");
|
||||
|
||||
will first create an object with the name C<document> (unless
|
||||
it exists already) and then define a property named C<form> to it,
|
||||
which is an object of type I<Array>. Therefore, in the JS code,
|
||||
you're going to be able define things like
|
||||
|
||||
document.form[0] = "value";
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub array_by_path {
|
||||
##################################################
|
||||
my ($self, $path) = @_;
|
||||
|
||||
my $array = JavaScript::SpiderMonkey::JS_NewArrayObject($self->{context});
|
||||
return $self->object_by_path($path, $array);
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>function_set($name, $funcref, [$obj])
|
||||
|
||||
Binds a Perl function provided as a coderef (C<$funcref>)
|
||||
to a newly created JS function
|
||||
named C<$name> in JS land.
|
||||
It's a real function (therefore bound to the global object) if C<$obj>
|
||||
is omitted. However, if C<$obj> is ref to
|
||||
a JS object (retrieved via C<$js-E<gt>object_by_path($path)> or the like),
|
||||
the function will be a I<method> of the specified object.
|
||||
|
||||
$js->function_set("write", sub { print @_ });
|
||||
# write("hello"); // In JS land
|
||||
|
||||
$obj = $j->object_by_path("navigator");
|
||||
$js->function_set("write", sub { print @_ }, $obj);
|
||||
# navigator.write("hello"); // In JS land
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub function_set {
|
||||
##################################################
|
||||
my ($self, $name, $func, $obj) = @_;
|
||||
|
||||
$obj ||= $self->{global_object}; # Defaults to global object
|
||||
|
||||
$self->{functions}->{${$obj}}->{$name} = $func;
|
||||
|
||||
return JavaScript::SpiderMonkey::JS_DefineFunction(
|
||||
$self->{context}, $obj, $name, 0, 0);
|
||||
}
|
||||
|
||||
##################################################
|
||||
sub function_dispatcher {
|
||||
##################################################
|
||||
my ($obj, $name, @args) = @_;
|
||||
|
||||
DEBUG "Dispatching function $obj-$name-@args";
|
||||
|
||||
our $GLOBAL;
|
||||
|
||||
## Find the path for this object.
|
||||
my $found = 0;
|
||||
foreach( keys( %{$GLOBAL->{objects}} ) ){
|
||||
if( ${$GLOBAL->{objects}->{$_}} eq $obj &&
|
||||
exists( $GLOBAL->{functions}->{$obj}->{$name} ) ){
|
||||
DEBUG "Function found";
|
||||
$found = 1;
|
||||
}
|
||||
}
|
||||
$obj = ${$GLOBAL->{global_object}} unless $found;
|
||||
|
||||
if(! exists $GLOBAL->{functions}->{$obj}->{$name}) {
|
||||
LOGDIE "Dispatcher: Can't find mapping for function $obj" .
|
||||
${$GLOBAL->{global_object}} . " '$name'";
|
||||
}
|
||||
|
||||
my $val = $GLOBAL->{functions}->{$obj}->{$name}->(@args);
|
||||
|
||||
DEBUG "retval=$val";
|
||||
|
||||
return $val;
|
||||
}
|
||||
|
||||
##################################################
|
||||
sub getsetter_dispatcher {
|
||||
##################################################
|
||||
my ($obj, $propname, $what, $value) = @_;
|
||||
|
||||
our $GLOBAL;
|
||||
|
||||
DEBUG "Dispatcher obj=$obj";
|
||||
DEBUG "prop=$propname what=$what value=$value";
|
||||
|
||||
DEBUG "GETTING properties/$obj/$propname/$what";
|
||||
|
||||
if(exists $GLOBAL->{properties}->{$obj}->{$propname}->{$what}) {
|
||||
my $entry = $GLOBAL->{properties}->{$obj}->{$propname}->{$what};
|
||||
my $path = $entry->{path};
|
||||
DEBUG "DISPATCHING for object $path ($what)";
|
||||
$entry->{callback}->($path, $value);
|
||||
} else {
|
||||
DEBUG "properties/$obj/$propname/$what doesn't exist";
|
||||
}
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>array_set_element($obj, $idx, $val)
|
||||
|
||||
Sets the element of the array C<$obj>
|
||||
at index position C<$idx> to the value C<$val>.
|
||||
C<$obj> is a reference to an object of type array
|
||||
(retrieved via C<$js-E<gt>object_by_path($path)> or the like).
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub array_set_element {
|
||||
##################################################
|
||||
my ($self, $obj, $idx, $val) = @_;
|
||||
|
||||
DEBUG "Setting $idx of $obj ($self->{context}) to $val";
|
||||
JavaScript::SpiderMonkey::JS_SetElement(
|
||||
$self->{context}, $obj, $idx, $val);
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>array_set_element_as_object($obj, $idx, $elobj)
|
||||
|
||||
Sets the element of the array C<$obj>
|
||||
at index position C<$idx> to the object C<$elobj>
|
||||
(both C<$obj> and C<$elobj> have been retrieved
|
||||
via C<$js-E<gt>object_by_path($path)> or the like).
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub array_set_element_as_object {
|
||||
##################################################
|
||||
my ($self, $obj, $idx, $elobj) = @_;
|
||||
|
||||
JavaScript::SpiderMonkey::JS_SetElementAsObject(
|
||||
$self->{context}, $obj, $idx, $elobj);
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>array_get_element($obj, $idx)
|
||||
|
||||
Gets the value of of the element at index C<$idx>
|
||||
of the object of type Array C<$obj>.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub array_get_element {
|
||||
##################################################
|
||||
my ($self, $obj, $idx) = @_;
|
||||
|
||||
my $rc = JavaScript::SpiderMonkey::JS_GetElement(
|
||||
$self->{context}, $obj, $idx);
|
||||
|
||||
DEBUG("Getting $idx of $obj ($self->{context}): ",
|
||||
($rc || "undef"));
|
||||
|
||||
return $rc;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>property_by_path($path, $value, [$getter], [$setter])
|
||||
|
||||
Sets the specified property of an object in C<$path> to the
|
||||
value C<$value>. C<$path> is the full name of the property,
|
||||
including the object(s) in JS land it belongs to:
|
||||
|
||||
$js-E<gt>property_by_path("document.location.href", "abc");
|
||||
|
||||
This first creates the object C<document> (if it doesn't exist already),
|
||||
then the object C<document.location>, then attaches the property
|
||||
C<href> to it and sets it to C<"abc">.
|
||||
|
||||
C<$getter> and C<$setter> are coderefs that will be called by
|
||||
the JavaScript engine when the respective property's value is
|
||||
requested or set:
|
||||
|
||||
sub getter {
|
||||
my($property_path, $value) = @_;
|
||||
print "$property_path has value $value\n";
|
||||
}
|
||||
|
||||
sub setter {
|
||||
my($property_path, $value) = @_;
|
||||
print "$property_path set to value $value\n";
|
||||
}
|
||||
|
||||
$js-E<gt>property_by_path("document.location.href", "abc",
|
||||
\&getter, \&setter);
|
||||
|
||||
If you leave out C<$getter> and C<$setter>, there's going to be no
|
||||
callbacks triggerd while the properity is set or queried.
|
||||
If you just want to specify a C<$setter>, but no C<$getter>,
|
||||
set the C<$getter> to C<undef>.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub property_by_path {
|
||||
##################################################
|
||||
my ($self, $path, $value, $getter, $setter) = @_;
|
||||
|
||||
DEBUG "Retrieve/Create property $path";
|
||||
|
||||
(my $opath = $path) =~ s/\.[^.]+$//;
|
||||
my $obj = $self->object_by_path($opath);
|
||||
unless(defined $obj) {
|
||||
LOGWARN "No object pointer found to $opath";
|
||||
return undef;
|
||||
}
|
||||
|
||||
DEBUG "$opath: obj=$obj";
|
||||
|
||||
$value = 'undef' unless defined $value;
|
||||
|
||||
DEBUG "Define property $self->{context}, $obj, $path, $value";
|
||||
|
||||
(my $property = $path) =~ s/.*\.//;
|
||||
|
||||
my $prop = JavaScript::SpiderMonkey::JS_DefineProperty(
|
||||
$self->{context}, $obj, $property, $value);
|
||||
|
||||
DEBUG "SETTING properties/$$obj/$property/getter";
|
||||
if($getter) {
|
||||
# Store it under the original C pointer's value. We get
|
||||
# back a PTRREF from JS_DefineObject, but we need the
|
||||
# original value for the callback dispatcher.
|
||||
$self->{properties}->{$$obj}->{$property}->{getter}->{callback}
|
||||
= $getter;
|
||||
$self->{properties}->{$$obj}->{$property}->{getter}->{path} = $path;
|
||||
}
|
||||
|
||||
if($setter) {
|
||||
$self->{properties}->{$$obj}->{$property}->{setter}->{callback}
|
||||
= $setter;
|
||||
$self->{properties}->{$$obj}->{$property}->{setter}->{path} = $path;
|
||||
}
|
||||
|
||||
return $prop;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>object_by_path($path, [$newobj])
|
||||
|
||||
Get a pointer to an object with the path
|
||||
specified. Create it if it's not there yet.
|
||||
If C<$newobj> is provided, the ref is used to
|
||||
bind the existing object to the name in C<$path>.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub object_by_path {
|
||||
##################################################
|
||||
my ($self, $path, $newobj) = @_;
|
||||
|
||||
DEBUG "Retrieve/Create object $path";
|
||||
|
||||
DEBUG "Got a ", defined $newobj ? "predefined" : "undefined",
|
||||
" object";
|
||||
|
||||
my $obj = $self->{global_object};
|
||||
|
||||
my @parts = split /\./, $path;
|
||||
my $full = "";
|
||||
|
||||
return undef unless @parts;
|
||||
|
||||
while(@parts >= 1) {
|
||||
my $part = shift @parts;
|
||||
$full .= "." if $full;
|
||||
$full .= "$part";
|
||||
|
||||
if(exists $self->{objects}->{$full}) {
|
||||
$obj = $self->{objects}->{$full};
|
||||
DEBUG "Object $full exists: $obj";
|
||||
} else {
|
||||
my $gobj = $self->{global_object};
|
||||
if(defined $newobj and $path eq $full) {
|
||||
DEBUG "Setting $path to predefined object";
|
||||
$obj = JavaScript::SpiderMonkey::JS_DefineObject(
|
||||
$self->{context}, $obj, $part,
|
||||
JavaScript::SpiderMonkey::JS_GetClass($self->{context}, $newobj),
|
||||
$newobj);
|
||||
} else {
|
||||
$obj = JavaScript::SpiderMonkey::JS_DefineObject(
|
||||
$self->{context}, $obj, $part,
|
||||
$self->{global_class}, $self->{global_object});
|
||||
}
|
||||
$self->{objects}->{$full} = $obj;
|
||||
DEBUG "Object $full created: $obj";
|
||||
}
|
||||
}
|
||||
|
||||
return $obj;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>property_get($path)
|
||||
|
||||
Fetch the property specified by the C<$path>.
|
||||
|
||||
my $val = $js->property_get("document.location.href");
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub property_get {
|
||||
##################################################
|
||||
my ($self, $string) = @_;
|
||||
|
||||
my($path, $property) = ($string =~ /(.*)\.([^\.]+)$/);
|
||||
|
||||
if(!exists $self->{objects}->{$path}) {
|
||||
LOGWARN "Cannot find object $path via SpiderMonkey";
|
||||
return;
|
||||
}
|
||||
|
||||
DEBUG "Get property $self->{objects}->{$path}, $property";
|
||||
|
||||
return JavaScript::SpiderMonkey::JS_GetProperty(
|
||||
$self->{context}, $self->{objects}->{$path},
|
||||
$property);
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>eval($code)
|
||||
|
||||
Runs the specified piece of <$code> in the JS engine.
|
||||
Afterwards, property values of objects previously defined
|
||||
will be available via C<$j-E<gt>property_get($path)>
|
||||
and the like.
|
||||
|
||||
my $rc = $js->eval("write('hello');");
|
||||
|
||||
The method returns C<1> on success or else if
|
||||
there was an error in JS land. In case of an error, the JS
|
||||
error text will be available in C<$@>.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub eval {
|
||||
##################################################
|
||||
my ($self, $script) = @_;
|
||||
|
||||
return 1 unless defined $script;
|
||||
|
||||
my $ok =
|
||||
JavaScript::SpiderMonkey::JS_EvaluateScript(
|
||||
$self->{context},
|
||||
$self->{global_object},
|
||||
$script,
|
||||
$] > 5.007 ? bytes::length($script) : length($script),
|
||||
"Perl",
|
||||
0);
|
||||
|
||||
return $ok;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>ret_eval($code)
|
||||
|
||||
Runs the specified piece of <$code> in the JS engine.
|
||||
Differs from eval because it returns the results of
|
||||
the last executed expression from the JS context.
|
||||
|
||||
my $value = $js->ret_eval("2+2");
|
||||
|
||||
The method returns the result of the last evaluated
|
||||
JS expression. In case of an error, the JS
|
||||
error text will be available in C<$@>.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub ret_eval {
|
||||
##################################################
|
||||
my ($self, $script) = @_;
|
||||
|
||||
return 1 unless defined $script;
|
||||
|
||||
no warnings 'uninitialized'; #Silence a spurious undef warning I can't track down.
|
||||
my $ok =
|
||||
JavaScript::SpiderMonkey::JS_RetEvaluateScript(
|
||||
$self->{context},
|
||||
$self->{global_object},
|
||||
$script,
|
||||
#$] > 5.007 ? bytes::length($script) : length($script),
|
||||
length($script),
|
||||
"Perl",
|
||||
0);
|
||||
|
||||
return $ok;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>set_max_branch_operations($max_branch_operations)
|
||||
|
||||
Set the maximum number of allowed branch operations. This protects
|
||||
against infinite loops and guarantees that the eval operation
|
||||
will terminate.
|
||||
|
||||
=cut
|
||||
##################################################
|
||||
sub set_max_branch_operations {
|
||||
##################################################
|
||||
my ($self, $max_branch_operations) = @_;
|
||||
JavaScript::SpiderMonkey::JS_SetMaxBranchOperations($self->{context}, $max_branch_operations);
|
||||
}
|
||||
|
||||
##################################################
|
||||
sub dump {
|
||||
##################################################
|
||||
my ($self) = @_;
|
||||
|
||||
Data::Dumper::Dumper($self->{objects});
|
||||
}
|
||||
|
||||
##################################################
|
||||
sub debug_enabled {
|
||||
##################################################
|
||||
my $logger = Log::Log4perl::get_logger("JavaScript::SpiderMonkey");
|
||||
if(Log::Log4perl->initialized() and $logger->is_debug()) {
|
||||
# print "DEBUG IS ENABLED\n";
|
||||
return 1;
|
||||
} else {
|
||||
# print "DEBUG IS DISABLED\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 SpiderMonkey Installation
|
||||
|
||||
First, get the latest SpiderMonkey distribution from mozilla.org:
|
||||
http://www.mozilla.org/js/spidermonkey shows which releases are available.
|
||||
C<js-1.6.tar.gz> has been proven to work.
|
||||
|
||||
Untar it at the same directory level as you just untarred the
|
||||
C<JavaScript::SpiderMonkey> distribution you're currently reading.
|
||||
So, if you're currently in C</my/path/JavaScript-SpiderMonkey-v.vv>, do
|
||||
this:
|
||||
|
||||
cp js-1.6.tar.gz /my/path
|
||||
cd /my/path
|
||||
tar zxfv js-1.6.tar.gz
|
||||
|
||||
Then, compile the SpiderMonkey distribution, if you're on Linux,
|
||||
just use:
|
||||
|
||||
cd js/src
|
||||
make -f Makefile.ref
|
||||
|
||||
It's important that the js and JavaScript-SpiderMonkey-v.vv directories
|
||||
are at the same level:
|
||||
|
||||
[/my/path]$ ls
|
||||
JavaScript-SpiderMonkey-v.vv
|
||||
js
|
||||
js-1.6.tar.gz
|
||||
[/my/path]$
|
||||
|
||||
(Note that you *can* untar the SpiderMonkey distribution elsewhere,
|
||||
but, if so, then you need to edit the setting of $JSLIBPATH in Makefile.PL).
|
||||
|
||||
Next, you need to copy the shared library file thus constructed
|
||||
(e.g., libjs.so or js32.dll) to an appropriate directory on your library path.
|
||||
On Windows, this can also be the directory where the perl executable
|
||||
lives. On Unix, this has been shown to work without copying, but this way
|
||||
you need to keep the compiled binary in the C<js> build directory forever.
|
||||
Copying
|
||||
C<js/src/Your_OS_DBG.OBJ/libjs.so> to C</usr/local/lib> and
|
||||
making sure that C</usr/local/lib> is in your C<LD_LIBRARY_PATH>
|
||||
seems to be safest bet.
|
||||
|
||||
Now, build JavaScript::SpiderMonkey in the standard way:
|
||||
|
||||
cd JavaScript-SpiderMonkey-v.vv
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
=head1 E4X SUPPORT
|
||||
|
||||
To build JavaScript-SpiderMonkey with E4X (ECMAScript for XML) support:
|
||||
|
||||
perl Makefile.PL -E4X
|
||||
|
||||
Please note that E4X support is only supported since SpiderMonkey release 1.6.
|
||||
|
||||
=head1 THREAD SAFETY
|
||||
|
||||
To build JavaScript-SpiderMonkey when using a thread safe version of SpiderMonkey:
|
||||
|
||||
perl Makefile.PL -JS_THREADSAFE
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
Mike Schilli, <m at perlmeister dot com>
|
||||
Thomas Busch, <tbusch at cpan dot org> (current maintainer)
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (c) 2002-2005 Mike Schilli
|
||||
Copyright (c) 2006-2007 Thomas Busch
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
|
@ -1,824 +0,0 @@
|
|||
/* --------------------------------------------------------------------- */
|
||||
/* SpiderMonkey.xs -- Perl Interface to the SpiderMonkey JavaScript */
|
||||
/* implementation. */
|
||||
/* */
|
||||
/* Revision: $Revision: 1.6 $ */
|
||||
/* Last Checkin: $Date: 2007/06/08 19:03:08 $ */
|
||||
/* By: $Author: thomas_busch $ */
|
||||
/* */
|
||||
/* Author: Mike Schilli mschilli1@aol.com, 2001 */
|
||||
/* --------------------------------------------------------------------- */
|
||||
|
||||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
#include "jsapi.h"
|
||||
#include "SpiderMonkey.h"
|
||||
|
||||
#ifdef _MSC_VER
|
||||
/* As suggested in https://rt.cpan.org/Ticket/Display.html?id=6984 */
|
||||
#define snprintf _snprintf
|
||||
#endif
|
||||
|
||||
/* JSRuntime needs this global class */
|
||||
static
|
||||
JSClass global_class = {
|
||||
"Global", 0,
|
||||
JS_PropertyStub, JS_PropertyStub, JS_PropertyStub, JS_PropertyStub,
|
||||
JS_EnumerateStub, JS_ResolveStub, JS_ConvertStub, JS_FinalizeStub
|
||||
};
|
||||
|
||||
static int Debug = 0;
|
||||
|
||||
static int max_branch_operations = 0;
|
||||
|
||||
/*==================================*/
|
||||
/* Begin Dirty Hackery */
|
||||
/*==================================*/
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
int obj_to_str(
|
||||
JSContext *cx,
|
||||
JSObject *obj,
|
||||
SV *perl_str
|
||||
/* --------------------------------------------------------------------- */
|
||||
) {
|
||||
JSIdArray *fields = JS_Enumerate( cx, obj );
|
||||
int i = 0;
|
||||
jsval property;
|
||||
|
||||
sv_catpvn( perl_str, "{ ", 2 );
|
||||
/*printf("OBJ_TO_STR\n");
|
||||
printf("Length: %i\n", fields->length);*/
|
||||
|
||||
for( i = 0; i < fields->length; i++ )
|
||||
{
|
||||
jsid id = fields->vector[i];
|
||||
jsval id_val;
|
||||
char *prop_name;
|
||||
|
||||
JS_IdToValue( cx, id, &id_val );
|
||||
prop_name = JS_GetStringBytes(JS_ValueToString(cx, id_val));
|
||||
JS_GetProperty( cx, obj, prop_name, &property );
|
||||
|
||||
/* printf("Adding %s to pv\n", prop_name); */
|
||||
sv_catpvn( perl_str, prop_name, strlen( prop_name ) );
|
||||
sv_catpvn( perl_str, ": ", 2 );
|
||||
/* printf( "Str: %s\n", SvPVbyte_nolen( perl_str ) ); */
|
||||
|
||||
if( JSVAL_IS_OBJECT( property ) )
|
||||
{
|
||||
JSObject *prop_obj;
|
||||
JS_ValueToObject( cx, property, &prop_obj );
|
||||
obj_to_str( cx, prop_obj, perl_str );
|
||||
}
|
||||
else
|
||||
{
|
||||
JSString *prop_str = JS_ValueToString( cx, property );
|
||||
sv_catpvn( perl_str, JS_GetStringBytes( prop_str ), JS_GetStringLength( prop_str ) );
|
||||
/*sv_catpvn( perl_str, " ", 1 );*/
|
||||
}
|
||||
|
||||
if( i < ( fields->length - 1 ) )
|
||||
{
|
||||
sv_catpvn( perl_str, ", ", 2 );
|
||||
}
|
||||
}
|
||||
|
||||
sv_catpvn( perl_str, "}", 1 );
|
||||
JS_DestroyIdArray( cx, fields );
|
||||
return 1;
|
||||
}
|
||||
/*==================================*/
|
||||
/* End Dirty Hackery */
|
||||
/*==================================*/
|
||||
|
||||
/* It's kinda silly that we have to replicate this for getters and setters,
|
||||
* but there doesn't seem to be a way to distinguish between getters
|
||||
* and setters if we use the same function. (Somewhere I read in a
|
||||
* usenet posting there's something like IS_ASSIGN, but this doesn't
|
||||
* seem to be in SpiderMonkey 1.5).
|
||||
*/
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
JSBool getsetter_dispatcher(
|
||||
JSContext *cx,
|
||||
JSObject *obj,
|
||||
jsval id,
|
||||
jsval *vp,
|
||||
char *what
|
||||
/* --------------------------------------------------------------------- */
|
||||
) {
|
||||
dSP;
|
||||
|
||||
/* Call back into perl */
|
||||
ENTER ;
|
||||
SAVETMPS ;
|
||||
PUSHMARK(SP);
|
||||
/* A somewhat nasty trick: Since JS_DefineObject() down below
|
||||
* returns a *JS_Object, which is typemapped as T_PTRREF,
|
||||
* and which is a reference (!) pointing to the real C pointer,
|
||||
* we need to brutally obtain the obj's address by casting
|
||||
* it to an int and forming a scalar out of it.
|
||||
* On the other hand, when Spidermonkey.pm stores the
|
||||
* object's setters/getters, it will dereference
|
||||
* what it gets from JS_DefineObject() (therefore
|
||||
* obtain the object's address in memory) to index its
|
||||
* hash table.
|
||||
* I hope all reasonable machines can hold an address in
|
||||
* an int.
|
||||
*/
|
||||
XPUSHs(sv_2mortal(newSViv((int)obj)));
|
||||
XPUSHs(sv_2mortal(newSVpv(JS_GetStringBytes(JSVAL_TO_STRING(id)), 0)));
|
||||
XPUSHs(sv_2mortal(newSVpv(what, 0)));
|
||||
XPUSHs(sv_2mortal(newSVpv(JS_GetStringBytes(JSVAL_TO_STRING(*vp)), 0)));
|
||||
PUTBACK;
|
||||
call_pv("JavaScript::SpiderMonkey::getsetter_dispatcher", G_DISCARD);
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
|
||||
return JS_TRUE;
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
JSBool getter_dispatcher(
|
||||
JSContext *cx,
|
||||
JSObject *obj,
|
||||
jsval id,
|
||||
jsval *vp
|
||||
/* --------------------------------------------------------------------- */
|
||||
) {
|
||||
return getsetter_dispatcher(cx, obj, id, vp, "getter");
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
JSBool setter_dispatcher(
|
||||
JSContext *cx,
|
||||
JSObject *obj,
|
||||
jsval id,
|
||||
jsval *vp
|
||||
/* --------------------------------------------------------------------- */
|
||||
) {
|
||||
return getsetter_dispatcher(cx, obj, id, vp, "setter");
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
int debug_enabled(
|
||||
/* --------------------------------------------------------------------- */
|
||||
) {
|
||||
dSP;
|
||||
|
||||
int enabled = 0;
|
||||
int count = 0;
|
||||
|
||||
/* Call back into perl */
|
||||
ENTER ;
|
||||
SAVETMPS ;
|
||||
PUTBACK;
|
||||
count = call_pv("JavaScript::SpiderMonkey::debug_enabled", G_SCALAR);
|
||||
if(count == 1) {
|
||||
if(POPi == 1) {
|
||||
enabled = 1;
|
||||
}
|
||||
}
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
|
||||
return enabled;
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
static JSBool
|
||||
FunctionDispatcher(JSContext *cx, JSObject *obj, uintN argc,
|
||||
jsval *argv, jsval *rval) {
|
||||
/* --------------------------------------------------------------------- */
|
||||
dSP;
|
||||
SV *sv;
|
||||
char *n_jstr;
|
||||
int n_jnum;
|
||||
double n_jdbl;
|
||||
unsigned i;
|
||||
int count;
|
||||
JSFunction *fun;
|
||||
fun = JS_ValueToFunction(cx, argv[-2]);
|
||||
|
||||
/* printf("Function %s received %d arguments\n",
|
||||
(char *) JS_GetFunctionName(fun),
|
||||
(int) argc); */
|
||||
|
||||
/* Call back into perl */
|
||||
ENTER ;
|
||||
SAVETMPS ;
|
||||
PUSHMARK(SP);
|
||||
XPUSHs(sv_2mortal(newSViv((int)obj)));
|
||||
XPUSHs(sv_2mortal(newSVpv(
|
||||
JS_GetFunctionName(fun), 0)));
|
||||
for(i=0; i<argc; i++) {
|
||||
XPUSHs(sv_2mortal(newSVpv(
|
||||
JS_GetStringBytes(JS_ValueToString(cx, argv[i])), 0)));
|
||||
}
|
||||
PUTBACK;
|
||||
count = call_pv("JavaScript::SpiderMonkey::function_dispatcher", G_SCALAR);
|
||||
SPAGAIN;
|
||||
|
||||
if(Debug)
|
||||
fprintf(stderr, "DEBUG: Count is %d\n", count);
|
||||
|
||||
if( count > 0) {
|
||||
sv = POPs;
|
||||
if(SvROK(sv)) {
|
||||
/* Im getting a perl reference here, the user
|
||||
* seems to want to send a perl object to jscript
|
||||
* ok, we will do it, although it seems like a painful
|
||||
* thing to me.
|
||||
*/
|
||||
|
||||
if(Debug)
|
||||
fprintf(stderr, "DEBUG: %lx is a ref!\n", (long) sv);
|
||||
*rval = OBJECT_TO_JSVAL(SvIV(SvRV(sv)));
|
||||
}
|
||||
else if(SvIOK(sv)) {
|
||||
/* It appears that we have been sent an int return
|
||||
* value. Thats fine we can give javascript an int
|
||||
*/
|
||||
n_jnum=SvIV(sv);
|
||||
if(Debug)
|
||||
fprintf(stderr, "DEBUG: %lx is an int (%d)\n", (long) sv,n_jnum);
|
||||
*rval = INT_TO_JSVAL(n_jnum);
|
||||
} else if(SvNOK(sv)) {
|
||||
/* It appears that we have been sent an double return
|
||||
* value. Thats fine we can give javascript an double
|
||||
*/
|
||||
n_jdbl=SvNV(sv);
|
||||
|
||||
if(Debug)
|
||||
fprintf(stderr, "DEBUG: %lx is a double(%f)\n", (long) sv,n_jdbl);
|
||||
*rval = DOUBLE_TO_JSVAL(JS_NewDouble(cx, n_jdbl));
|
||||
} else if(SvPOK(sv)) {
|
||||
n_jstr = SvPV(sv, PL_na);
|
||||
//warn("DEBUG: %s (%d)\n", n_jstr);
|
||||
*rval = STRING_TO_JSVAL(JS_NewStringCopyZ(cx, n_jstr));
|
||||
}
|
||||
}
|
||||
|
||||
PUTBACK;
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
|
||||
return JS_TRUE;
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
static void
|
||||
ErrorReporter(JSContext *cx, const char *message, JSErrorReport *report) {
|
||||
/* --------------------------------------------------------------------- */
|
||||
char msg[400];
|
||||
snprintf(msg, sizeof(msg),
|
||||
"Error: %s at line %d: %s", message, report->lineno,
|
||||
report->linebuf);
|
||||
sv_setpv(get_sv("@", TRUE), msg);
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
static JSBool
|
||||
BranchHandler(JSContext *cx, JSScript *script) {
|
||||
/* --------------------------------------------------------------------- */
|
||||
PJS_Context* pcx = (PJS_Context*) JS_GetContextPrivate(cx);
|
||||
|
||||
pcx->branch_count++;
|
||||
if (pcx->branch_count > pcx->branch_max) {
|
||||
return JS_FALSE;
|
||||
} else {
|
||||
return JS_TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
MODULE = JavaScript::SpiderMonkey PACKAGE = JavaScript::SpiderMonkey
|
||||
PROTOTYPES: DISABLE
|
||||
|
||||
######################################################################
|
||||
char *
|
||||
JS_GetImplementationVersion()
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
RETVAL = (char *) JS_GetImplementationVersion();
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSRuntime *
|
||||
JS_NewRuntime(maxbytes)
|
||||
int maxbytes
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSRuntime *rt;
|
||||
CODE:
|
||||
{
|
||||
rt = JS_NewRuntime(maxbytes);
|
||||
if(!rt) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = rt;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_DestroyRuntime(rt)
|
||||
JSRuntime *rt
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
JS_DestroyRuntime(rt);
|
||||
RETVAL = 0;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSRuntime *
|
||||
JS_Init(maxbytes)
|
||||
int maxbytes
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSRuntime *rt;
|
||||
CODE:
|
||||
{
|
||||
rt = JS_Init(maxbytes);
|
||||
if(!rt) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
/* Replace this by Debug = debug_enabled(); once
|
||||
* Log::Log4perl 0.47 is out */
|
||||
Debug = 0;
|
||||
RETVAL = rt;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSContext *
|
||||
JS_NewContext(rt, stack_chunk_size)
|
||||
JSRuntime *rt
|
||||
int stack_chunk_size
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSContext *cx;
|
||||
CODE:
|
||||
{
|
||||
PJS_Context* pcx;
|
||||
cx = JS_NewContext(rt, stack_chunk_size);
|
||||
if(!cx) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
#ifdef E4X
|
||||
JS_SetOptions(cx,JSOPTION_XML);
|
||||
#endif
|
||||
|
||||
Newz(1, pcx, 1, PJS_Context);
|
||||
JS_SetContextPrivate(cx, (void *)pcx);
|
||||
|
||||
RETVAL = cx;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_DestroyContext(cx)
|
||||
JSContext *cx;
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
JS_DestroyContext(cx);
|
||||
Safefree(JS_GetContextPrivate(cx));
|
||||
RETVAL = 0;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSObject *
|
||||
JS_NewObject(cx, class, proto, parent)
|
||||
JSContext * cx
|
||||
JSClass * class
|
||||
JSObject * proto
|
||||
JSObject * parent
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSObject *obj;
|
||||
CODE:
|
||||
{
|
||||
obj = JS_NewObject(cx, class, NULL, NULL);
|
||||
if(!obj) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = obj;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSObject *
|
||||
JS_InitClass(cx, iobj, parent_proto, clasp, constructor, nargs, ps, fs, static_ps, static_fs)
|
||||
JSContext * cx
|
||||
JSObject *iobj
|
||||
JSObject *parent_proto
|
||||
JSClass *clasp
|
||||
JSNative constructor
|
||||
int nargs
|
||||
JSPropertySpec *ps
|
||||
JSFunctionSpec *fs
|
||||
JSPropertySpec *static_ps
|
||||
JSFunctionSpec *static_fs
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSObject *obj;
|
||||
uintN na;
|
||||
INIT:
|
||||
na = (uintN) nargs;
|
||||
CODE:
|
||||
{
|
||||
obj = JS_InitClass(cx, iobj, parent_proto, clasp,
|
||||
constructor, nargs, ps, fs, static_ps,
|
||||
static_fs);
|
||||
if(!obj) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = obj;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSClass *
|
||||
JS_GlobalClass()
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSClass *gc;
|
||||
CODE:
|
||||
{
|
||||
gc = &global_class;
|
||||
RETVAL = gc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
void
|
||||
JS_ForceLatest(cx)
|
||||
JSContext * cx
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
JS_SetVersion(cx, JSVERSION_LATEST);
|
||||
}
|
||||
|
||||
######################################################################
|
||||
char*
|
||||
JS_RetEvaluateScript(cx, gobj, script, length, filename, lineno)
|
||||
JSContext * cx
|
||||
JSObject * gobj
|
||||
char * script
|
||||
int length
|
||||
char * filename
|
||||
int lineno
|
||||
######################################################################
|
||||
PREINIT:
|
||||
uintN len;
|
||||
uintN ln;
|
||||
int rc;
|
||||
jsval jsval;
|
||||
JSString *js_string;
|
||||
char *return_string;
|
||||
INIT:
|
||||
len = (uintN) length;
|
||||
ln = (uintN) lineno;
|
||||
CODE:
|
||||
{
|
||||
rc = JS_EvaluateScript(cx, gobj, script, len, filename,
|
||||
ln, &jsval);
|
||||
if(!rc) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
|
||||
if( JSVAL_IS_OBJECT(jsval) )
|
||||
{
|
||||
SV* sv = NEWSV(5,10);
|
||||
JSObject *obj;
|
||||
JS_ValueToObject( cx, jsval, &obj );
|
||||
obj_to_str(cx,obj,sv);
|
||||
RETVAL = SvPVbyte_nolen( sv );
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
js_string = JS_ValueToString(cx, jsval);
|
||||
return_string = JS_GetStringBytes(js_string);
|
||||
RETVAL = return_string;
|
||||
}
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_EvaluateScript(cx, gobj, script, length, filename, lineno)
|
||||
JSContext * cx
|
||||
JSObject * gobj
|
||||
char * script
|
||||
int length
|
||||
char * filename
|
||||
int lineno
|
||||
######################################################################
|
||||
PREINIT:
|
||||
uintN len;
|
||||
uintN ln;
|
||||
int rc;
|
||||
jsval jsval;
|
||||
INIT:
|
||||
len = (uintN) length;
|
||||
ln = (uintN) lineno;
|
||||
CODE:
|
||||
{
|
||||
rc = JS_EvaluateScript(cx, gobj, script, len, filename,
|
||||
ln, &jsval);
|
||||
if(!rc) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_InitStandardClasses(cx, gobj)
|
||||
JSContext * cx
|
||||
JSObject * gobj
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
CODE:
|
||||
{
|
||||
rc = JS_InitStandardClasses(cx, gobj);
|
||||
if(!rc) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = (int) rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_DefineFunction(cx, obj, name, nargs, flags)
|
||||
JSContext * cx
|
||||
JSObject * obj
|
||||
char * name
|
||||
int nargs
|
||||
int flags
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSFunction *rc;
|
||||
CODE:
|
||||
{
|
||||
rc = JS_DefineFunction(cx, obj,
|
||||
(const char *) name, FunctionDispatcher,
|
||||
(uintN) nargs, (uintN) flags);
|
||||
if(!rc) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = (int) rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_SetErrorReporter(cx)
|
||||
JSContext * cx
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
JS_SetErrorReporter(cx, ErrorReporter);
|
||||
RETVAL = 0;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSObject *
|
||||
JS_DefineObject(cx, obj, name, class, proto)
|
||||
JSContext * cx
|
||||
JSObject * obj
|
||||
char * name
|
||||
JSClass * class
|
||||
JSObject * proto
|
||||
######################################################################
|
||||
PREINIT:
|
||||
SV *sv = sv_newmortal();
|
||||
CODE:
|
||||
{
|
||||
RETVAL = JS_DefineObject(cx, obj, name, class, proto, 0);
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_DefineProperty(cx, obj, name, value)
|
||||
JSContext * cx
|
||||
JSObject * obj
|
||||
char * name
|
||||
char * value
|
||||
#JSPropertyOp getter
|
||||
#JSPropertyOp setter
|
||||
#uintN flags
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
JSString *str;
|
||||
CODE:
|
||||
{
|
||||
str = JS_NewStringCopyZ(cx, value);
|
||||
|
||||
/* This implementation is somewhat sub-optimal, since it
|
||||
* calls back into perl even if no getters/setters have
|
||||
* been defined. The necessity for a callback is determined
|
||||
* at the perl level, where there's a data structure mapping
|
||||
* out each object's properties and their getter/setter settings.
|
||||
*/
|
||||
rc = JS_DefineProperty(cx, obj, name, STRING_TO_JSVAL(str),
|
||||
getter_dispatcher, setter_dispatcher, 0);
|
||||
RETVAL = (int) rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
void
|
||||
JS_GetProperty(cx, obj, name)
|
||||
JSContext * cx
|
||||
JSObject * obj
|
||||
char * name
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
jsval vp;
|
||||
JSString *str;
|
||||
SV *sv = sv_newmortal();
|
||||
PPCODE:
|
||||
{
|
||||
rc = JS_TRUE;
|
||||
rc = JS_GetProperty(cx, obj, name, &vp);
|
||||
if(rc) {
|
||||
str = JS_ValueToString(cx, vp);
|
||||
if(strcmp(JS_GetStringBytes(str), "undefined") == 0) {
|
||||
sv = &PL_sv_undef;
|
||||
} else {
|
||||
sv_setpv(sv, JS_GetStringBytes(str));
|
||||
}
|
||||
} else {
|
||||
sv = &PL_sv_undef;
|
||||
}
|
||||
XPUSHs(sv);
|
||||
}
|
||||
|
||||
######################################################################
|
||||
JSObject *
|
||||
JS_NewArrayObject(cx)
|
||||
JSContext * cx
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSObject *rc;
|
||||
CODE:
|
||||
{
|
||||
rc = JS_NewArrayObject(cx, 0, NULL);
|
||||
RETVAL = rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_SetElement(cx, obj, idx, valptr)
|
||||
JSContext *cx
|
||||
JSObject *obj
|
||||
int idx
|
||||
char *valptr
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
JSString *str;
|
||||
jsval val;
|
||||
CODE:
|
||||
{
|
||||
str = JS_NewStringCopyZ(cx, valptr);
|
||||
val = STRING_TO_JSVAL(str);
|
||||
rc = JS_SetElement(cx, obj, idx, &val);
|
||||
if(rc) {
|
||||
RETVAL = 1;
|
||||
} else {
|
||||
RETVAL = 0;
|
||||
}
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_SetElementAsObject(cx, obj, idx, elobj)
|
||||
JSContext *cx
|
||||
JSObject *obj
|
||||
int idx
|
||||
JSObject *elobj
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
jsval val;
|
||||
CODE:
|
||||
{
|
||||
val = OBJECT_TO_JSVAL(elobj);
|
||||
rc = JS_SetElement(cx, obj, idx, &val);
|
||||
if(rc) {
|
||||
RETVAL = 1;
|
||||
} else {
|
||||
RETVAL = 0;
|
||||
}
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
void
|
||||
JS_GetElement(cx, obj, idx)
|
||||
JSContext *cx
|
||||
JSObject *obj
|
||||
int idx
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
jsval vp;
|
||||
JSString *str;
|
||||
SV *sv = sv_newmortal();
|
||||
PPCODE:
|
||||
{
|
||||
rc = JS_GetElement(cx, obj, idx, &vp);
|
||||
if(rc) {
|
||||
str = JS_ValueToString(cx, vp);
|
||||
if(strcmp(JS_GetStringBytes(str), "undefined") == 0) {
|
||||
sv = &PL_sv_undef;
|
||||
} else {
|
||||
sv_setpv(sv, JS_GetStringBytes(str));
|
||||
}
|
||||
} else {
|
||||
sv = &PL_sv_undef;
|
||||
}
|
||||
XPUSHs(sv);
|
||||
}
|
||||
|
||||
######################################################################
|
||||
JSClass *
|
||||
JS_GetClass(cx, obj)
|
||||
JSContext * cx
|
||||
JSObject * obj
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSClass *rc;
|
||||
CODE:
|
||||
{
|
||||
#ifdef JS_THREADSAFE
|
||||
rc = JS_GetClass(cx, obj);
|
||||
#else
|
||||
rc = JS_GetClass(obj);
|
||||
#endif
|
||||
RETVAL = rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
|
||||
######################################################################
|
||||
void
|
||||
JS_SetMaxBranchOperations(cx, max_branch_operations)
|
||||
JSContext *cx
|
||||
int max_branch_operations
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
PJS_Context* pcx = (PJS_Context *) JS_GetContextPrivate(cx);
|
||||
pcx->branch_count = 0;
|
||||
pcx->branch_max = max_branch_operations;
|
||||
JS_SetBranchCallback(cx, BranchHandler);
|
||||
}
|
||||
OUTPUT:
|
||||
|
||||
|
||||
######################################################################
|
||||
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
######################################################################
|
||||
# Typemap for JavaScript::SpiderMonkey
|
||||
#
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
# Author: Mike Schilli mschilli1@aol.com, 2002
|
||||
######################################################################
|
||||
JSRuntime * T_PTRREF
|
||||
JSContext * T_PTRREF
|
||||
JSClass * T_PTRREF
|
||||
JSObject * T_PTRREF
|
||||
JSNative T_PTRREF
|
||||
JSPropertySpec * T_PTRREF
|
||||
JSFunctionSpec * T_PTRREF
|
||||
uintN T_SV
|
||||
JSBool T_SV
|
||||
|
|
@ -1,94 +0,0 @@
|
|||
Revision history for Perl extension JavaScript::SpiderMonkey.
|
||||
|
||||
0.19 (05/09/2007)
|
||||
(tb) Allocate correct amount of memory for scripts that contain UTF-8
|
||||
characters with internal UTF-8 flag on.
|
||||
|
||||
0.18 (08/06/2007)
|
||||
(tb) Added protection against infinite loops
|
||||
(tb) Added support for JS_THREADSAFE
|
||||
|
||||
0.17 (27/07/2006)
|
||||
(tb) Made sure eval function doesn't produce warnings when script
|
||||
variable is uninitialized.
|
||||
[was supposed to be part of 0.16 but is actually part of 0.17]
|
||||
(tb) Added support for E4X
|
||||
|
||||
0.16 (13/06/2006)
|
||||
(tb) Added patch initially proposed by marc [at] igneousconsulting.com
|
||||
and subsequently modified by Agent Zhang that allows mapped perl
|
||||
functions to return varied datatypes back to JavaScript
|
||||
|
||||
0.15 (28/02/2006)
|
||||
(tb) Rewrote Makefile.PL to work on more platforms
|
||||
|
||||
0.14 (12/02/2006)
|
||||
(tb) Removed remaining debug info
|
||||
|
||||
0.13 (05/02/2006)
|
||||
(tb) Removed debug info
|
||||
(tb) Made sure Makefile.PL finds libjs if installed in /usr/lib or
|
||||
/usr/local/lib
|
||||
|
||||
0.12 (12/03/2005)
|
||||
(ms) Makefile.PL prerequisite changed from undef to '0'.
|
||||
(ms) Thomas Busch added a check to Makefile.PL to find an already
|
||||
installed JS lib.
|
||||
|
||||
0.11 (08/22/2004)
|
||||
* (ms) Added Log::Log4perl dependency in Makefile.PL as suggested
|
||||
by an anonymous posting on rt.cpan.org.
|
||||
* (ms) Added #define for MSC compiler as suggested in
|
||||
https://rt.cpan.org/Ticket/Display.html?id=6984
|
||||
* (ms) Roger Crew <crew@cs.stanford.edu> provided patches for
|
||||
a clean Win32 compile plus README text on installing the dll/so.
|
||||
|
||||
0.10 06/20/2004
|
||||
* Nikita Savin <nikita@savin.go2serve.net> provided a patch to
|
||||
set $@ instead of printing to STDERR in case of a JS error.
|
||||
* Added patch by Chris Blaise <cblaise@esoft.com>:
|
||||
- Different objects can have the same named function. If no
|
||||
object is specified on function_set, it's global.
|
||||
* Log4perl in for debugging
|
||||
* Chris Blaise submitted a patch to have a perl callback return
|
||||
an object to JS. Applied with modifications, longer term we need
|
||||
a solution on how the perl callback tells the JS wrapper what's coming
|
||||
back: A JS string, an object or an integer.
|
||||
|
||||
0.09 02/20/2004
|
||||
* Max Maischein added Win32 installation steps in Makefile.PL
|
||||
|
||||
0.08 09/19/2002
|
||||
* Doc bug fixed, reported by Yoz Grahame.
|
||||
|
||||
0.07 09/14/2002
|
||||
* Release mgmt changed
|
||||
|
||||
0.06 07/10/2002
|
||||
* Made M*PL smarter to detect the JS target platform
|
||||
|
||||
0.05 06/23/2002
|
||||
* Added installation instructions to README.
|
||||
|
||||
0.04 06/23/2002
|
||||
* Added test case for just setter or just getter
|
||||
* Added documentation
|
||||
* Updated todo list
|
||||
|
||||
0.03 06/23/2002
|
||||
* Added setters and getters for properties
|
||||
|
||||
0.02 01/20/2002
|
||||
* Fixed properties (get/set)
|
||||
|
||||
0.01 01/03/2002
|
||||
* Where it all began.
|
||||
|
||||
TODO:
|
||||
* setters/getters for arrays
|
||||
* Get rid of GLOBAL and the limitation to one instance
|
||||
* getter/setter called every time, callback settings checked
|
||||
at perl level only
|
||||
* Make fixed constants in init() configurable (1000000)
|
||||
* Allow for different contexts
|
||||
* Rethink function names (by_path, function_set etc.)
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
|
||||
How to install JavaScript::SpiderMonkey
|
||||
|
||||
Get the latest SpiderMonkey distribution from mozilla.org:
|
||||
http://www.mozilla.org/js/spidermonkey shows which releases are available.
|
||||
http://ftp.mozilla.org/pub/js/js-1.5-rc3a.tar.gz has been proven to work.
|
||||
|
||||
Untar it at the same directory level as the distribution of the
|
||||
JavaScript::SpiderMonkey perl module distribution whichs README
|
||||
you're currently reading:
|
||||
|
||||
cd ..
|
||||
tar zxfv js-1.5-rc3a.tar.gz
|
||||
|
||||
It's important that the js and JavaScript-SpiderMonkey-v.vv directories
|
||||
are at the same level:
|
||||
|
||||
$ls
|
||||
JavaScript-SpiderMonkey-1.00
|
||||
js
|
||||
js-1.5-rc3a.tar.gz
|
||||
|
||||
Now, build JavaScript::SpiderMonkey in the standard way:
|
||||
|
||||
cd JavaScript-SpiderMonkey-1.00
|
||||
perl Makefile.PL
|
||||
gmake
|
||||
gmake test
|
||||
gmake install
|
||||
|
||||
-- and you're good to go! Have fun.
|
||||
|
||||
Mike Schilli, m@perlmeister.com, 2002
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
Changes
|
||||
INSTALL
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
MANIFEST.SKIP
|
||||
META.yml Module meta-data (added by MakeMaker)
|
||||
README
|
||||
SpiderMonkey.pm
|
||||
SpiderMonkey.xs
|
||||
SpiderMonkey.h
|
||||
t/000readme.t
|
||||
t/001properties.t
|
||||
t/002functions.t
|
||||
t/003properties.t
|
||||
t/004setget.t
|
||||
t/005error.t
|
||||
t/006objmeth.t
|
||||
t/007funcret.t
|
||||
t/00array.t
|
||||
t/01doc-href.t
|
||||
t/02nav-appv.t
|
||||
t/03doc-write.t
|
||||
t/04loop.t
|
||||
t/05form.t
|
||||
t/06form2.t
|
||||
t/07func.t
|
||||
t/08func2.t
|
||||
t/09meth.t
|
||||
t/10elobj.t
|
||||
t/11intret.t
|
||||
t/12dblret.t
|
||||
t/13strret.t
|
||||
t/init.pl
|
||||
typemap
|
||||
util/download.pl
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
blib
|
||||
^Makefile$
|
||||
^Makefile.old$
|
||||
CVS
|
||||
.cvsignore
|
||||
docs
|
||||
MANIFEST.bak
|
||||
adm/release
|
||||
^SpiderMonkey.bs$
|
||||
^SpiderMonkey.c$
|
||||
^SpiderMonkey.o$
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
--- #YAML:1.0
|
||||
name: JavaScript-SpiderMonkey
|
||||
version: 0.19
|
||||
abstract: Perl interface to the JavaScript Engine
|
||||
license: ~
|
||||
generated_by: ExtUtils::MakeMaker version 6.36
|
||||
distribution_type: module
|
||||
requires:
|
||||
Data::Dumper: 0
|
||||
Log::Log4perl: 0
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.2.html
|
||||
version: 1.2
|
||||
author:
|
||||
- Mike Schilli <m@perlmeister.com>
|
||||
|
|
@ -1,166 +0,0 @@
|
|||
######################################################################
|
||||
#
|
||||
# MakeMaker file for JavaScript::SpiderMonkey
|
||||
#
|
||||
# Revision: $Revision: 1.5 $
|
||||
# Last Checkin: $Date: 2007/06/08 19:03:08 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Authors: Mike Schilli m@perlmeister.com, 2002-2005
|
||||
# Thomas Busch tbusch@cpan.org, 2006
|
||||
#
|
||||
######################################################################
|
||||
|
||||
use ExtUtils::MakeMaker;
|
||||
use Getopt::Long;
|
||||
|
||||
# Get the right lib and include dirs for different platforms
|
||||
|
||||
my $JS_LIB_DIR;
|
||||
my @JS_INCL_DIRS;
|
||||
|
||||
my @c_header_files = qw(
|
||||
jsapi.h
|
||||
jsautocfg.h
|
||||
);
|
||||
|
||||
my @possible_libraries = qw(
|
||||
libjs.a
|
||||
js32.dll
|
||||
libmozjs.so
|
||||
);
|
||||
|
||||
my %possible_install_paths = (
|
||||
"../js/src/*" => "../js/src",
|
||||
"/usr/lib" => "/usr/include",
|
||||
"/usr/local/lib" => "/usr/local/include",
|
||||
"/usr/lib/firefox" => "/usr/include/firefox",
|
||||
);
|
||||
|
||||
my ($JS_LIB_DIR, @JS_INCL_DIRS, $JS_LIB_NAME);
|
||||
|
||||
foreach my $install_path(keys %possible_install_paths) {
|
||||
foreach my $possible_lib(@possible_libraries) {
|
||||
foreach my $libfile(glob "$install_path/$possible_lib") {
|
||||
next if ! -f $libfile;
|
||||
my $include_path = $possible_install_paths{$install_path};
|
||||
foreach my $c_header(@c_header_files) {
|
||||
if (-f "$include_path/$c_header") {
|
||||
my $include_dir = "$include_path/$c_header";
|
||||
$include_dir =~ s/$c_header$//;
|
||||
push @JS_INCL_DIRS, $include_dir;
|
||||
}
|
||||
foreach my $headerfile(glob "$include_path/*/$c_header") {
|
||||
my $include_dir = $headerfile;
|
||||
$include_dir =~ s/$c_header$//;
|
||||
push @JS_INCL_DIRS, $include_dir;
|
||||
}
|
||||
}
|
||||
if (scalar(@JS_INCL_DIRS) == scalar(@c_header_files)) {
|
||||
$JS_LIB_DIR = $libfile;
|
||||
$JS_LIB_DIR =~ s/$possible_lib$//;
|
||||
|
||||
$JS_LIB_NAME = $possible_lib;
|
||||
$JS_LIB_NAME =~ s/\.(a|so|dll)$//;
|
||||
$JS_LIB_NAME =~ s/^lib//;
|
||||
|
||||
last;
|
||||
} else {
|
||||
@JS_INCL_DIRS = ();
|
||||
}
|
||||
}
|
||||
last if $JS_LIB_DIR;
|
||||
}
|
||||
last if $JS_LIB_DIR;
|
||||
}
|
||||
|
||||
if ($JS_INCL_DIRS[0] eq $JS_INCL_DIRS[1]) {
|
||||
shift @JS_INCL_DIRS;
|
||||
}
|
||||
|
||||
## If no SpiderMonkey library found report that and exit.
|
||||
## Otherwise print lib and include paths.
|
||||
|
||||
if (!$JS_LIB_DIR) {
|
||||
print <<EOT;
|
||||
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
This module requires the SpiderMonkey C library -- please read the
|
||||
README file on how to download, compile and link it.
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
EOT
|
||||
exit 0;
|
||||
} else {
|
||||
print "JS_LIB_DIR: $JS_LIB_DIR\n";
|
||||
foreach my $include_dir(@JS_INCL_DIRS) {
|
||||
print "JS_INCL_DIR: $include_dir\n";
|
||||
}
|
||||
print "JS_LIB_NAME: $JS_LIB_NAME\n";
|
||||
}
|
||||
|
||||
#### Determine compile options
|
||||
##############################
|
||||
|
||||
my $JS_DEFINE;
|
||||
my $E4X = 0;
|
||||
my $JS_THREADSAFE = 0;
|
||||
|
||||
## Get options from command line
|
||||
GetOptions(
|
||||
"E4X" => \$E4X,
|
||||
"JS_THREADSAFE" => \$JS_THREADSAFE,
|
||||
);
|
||||
|
||||
|
||||
## Determine library name and system-related defines
|
||||
if ($^O ne 'MSWin32') {
|
||||
$JS_DEFINE = '-DXP_UNIX';
|
||||
} else {
|
||||
$JS_DEFINE = '-DXP_WIN';
|
||||
};
|
||||
|
||||
## Add E4X support if flag set.
|
||||
## For more info about E4X check http://en.wikipedia.org/wiki/E4X
|
||||
if ($E4X) {
|
||||
$JS_DEFINE .= " -DE4X";
|
||||
print "E4X support enabled\n";
|
||||
}
|
||||
|
||||
## Support compiling in thread safe environment
|
||||
if ($JS_THREADSAFE) {
|
||||
$JS_DEFINE .= " -DJS_THREADSAFE";
|
||||
print "Compiling with JS_THREADSAFE flag\n";
|
||||
}
|
||||
|
||||
|
||||
#### See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
#### the contents of the Makefile that is written.
|
||||
##################################################
|
||||
|
||||
WriteMakefile(
|
||||
'NAME' => 'JavaScript::SpiderMonkey',
|
||||
'VERSION_FROM' => 'SpiderMonkey.pm', # finds $VERSION
|
||||
'PREREQ_PM' => {
|
||||
'Log::Log4perl' => 0,
|
||||
'Data::Dumper' => 0,
|
||||
}, # e.g., Module::Name => 1.1
|
||||
($] >= 5.005 ? ## Add these new keywords supported since 5.005
|
||||
(ABSTRACT_FROM => 'SpiderMonkey.pm', # retrieve abstract from module
|
||||
AUTHOR => 'Mike Schilli <m@perlmeister.com>') : ()),
|
||||
'LIBS' => ["-L$JS_LIB_DIR -l$JS_LIB_NAME"], # e.g., '-lm'
|
||||
'DEFINE' => $JS_DEFINE, # e.g., '-DHAVE_SOMETHING'
|
||||
# Insert -I. if you add *.h files later:
|
||||
'INC' => "-I".join " -I", @JS_INCL_DIRS,
|
||||
# Un-comment this if you add C files to link with later:
|
||||
# 'OBJECT' => '$(O_FILES)', # link all the C files too
|
||||
);
|
||||
|
||||
######################################################################
|
||||
sub MY::postamble {
|
||||
######################################################################
|
||||
'
|
||||
README: SpiderMonkey.pm
|
||||
pod2text SpiderMonkey.pm >README
|
||||
';
|
||||
}
|
||||
211
deps/JavaScript-SpiderMonkey-0.19-patched/README
vendored
211
deps/JavaScript-SpiderMonkey-0.19-patched/README
vendored
|
|
@ -1,211 +0,0 @@
|
|||
######################################################################
|
||||
JavaScript::SpiderMonkey 0.17
|
||||
######################################################################
|
||||
|
||||
NAME
|
||||
JavaScript::SpiderMonkey - Perl interface to the JavaScript Engine
|
||||
|
||||
SYNOPSIS
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
|
||||
$js->init(); # Initialize Runtime/Context
|
||||
|
||||
# Define a perl callback for a new JavaScript function
|
||||
$js->function_set("print_to_perl", sub { print "@_\n"; });
|
||||
|
||||
# Create a new (nested) object and a property
|
||||
$js->property_by_path("document.location.href");
|
||||
|
||||
# Execute some code
|
||||
my $rc = $js->eval(q!
|
||||
document.location.href = append("http://", "www.aol.com");
|
||||
|
||||
print_to_perl("URL is ", document.location.href);
|
||||
|
||||
function append(first, second) {
|
||||
return first + second;
|
||||
}
|
||||
!);
|
||||
|
||||
# Get the value of a property set in JS
|
||||
my $url = $js->property_get("document.location.href");
|
||||
|
||||
$js->destroy();
|
||||
|
||||
INSTALL
|
||||
JavaScript::SpiderMonkey requires Mozilla's readily compiled
|
||||
SpiderMonkey 1.5 distribution or better. Please check "SpiderMonkey
|
||||
Installation".
|
||||
|
||||
DESCRIPTION
|
||||
JavaScript::SpiderMonkey is a Perl Interface to the SpiderMonkey
|
||||
JavaScript Engine. It is different from Claes Jacobsson's
|
||||
"JavaScript.pm" in that it offers two different levels of access:
|
||||
|
||||
[1] A 1:1 mapping of the SpiderMonkey API to Perl
|
||||
|
||||
[2] A more Perl-like API
|
||||
|
||||
This document describes [2], for [1], please check "SpiderMonkey.xs".
|
||||
|
||||
new()
|
||||
"$js = JavaScript::SpiderMonkey->new()" creates a new object to work
|
||||
with. To initialize the JS runtime, call "$js->init()" afterwards.
|
||||
|
||||
$js->destroy()
|
||||
"$js->destroy()" destroys the current runtime and frees up all memory.
|
||||
|
||||
$js->init()
|
||||
"$js->init()" initializes the SpiderMonkey engine by creating a context,
|
||||
default classes and objects and adding an error reporter.
|
||||
|
||||
$js->array_by_path($name)
|
||||
Creates an object of type *Array* in the JS runtime:
|
||||
|
||||
$js->array_by_path("document.form");
|
||||
|
||||
will first create an object with the name "document" (unless it exists
|
||||
already) and then define a property named "form" to it, which is an
|
||||
object of type *Array*. Therefore, in the JS code, you're going to be
|
||||
able define things like
|
||||
|
||||
document.form[0] = "value";
|
||||
|
||||
$js->function_set($name, $funcref, [$obj])
|
||||
Binds a Perl function provided as a coderef ($funcref) to a newly
|
||||
created JS function named $name in JS land. It's a real function
|
||||
(therefore bound to the global object) if $obj is omitted. However, if
|
||||
$obj is ref to a JS object (retrieved via "$js->object_by_path($path)"
|
||||
or the like), the function will be a *method* of the specified object.
|
||||
|
||||
$js->function_set("write", sub { print @_ });
|
||||
# write("hello"); // In JS land
|
||||
|
||||
$obj = $j->object_by_path("navigator");
|
||||
$js->function_set("write", sub { print @_ }, $obj);
|
||||
# navigator.write("hello"); // In JS land
|
||||
|
||||
$js->array_set_element($obj, $idx, $val)
|
||||
Sets the element of the array $obj at index position $idx to the value
|
||||
$val. $obj is a reference to an object of type array (retrieved via
|
||||
"$js->object_by_path($path)" or the like).
|
||||
|
||||
$js->array_set_element_as_object($obj, $idx, $elobj)
|
||||
Sets the element of the array $obj at index position $idx to the object
|
||||
$elobj (both $obj and $elobj have been retrieved via
|
||||
"$js->object_by_path($path)" or the like).
|
||||
|
||||
$js->array_get_element($obj, $idx)
|
||||
Gets the value of of the element at index $idx of the object of type
|
||||
Array $obj.
|
||||
|
||||
$js->property_by_path($path, $value, [$getter], [$setter])
|
||||
Sets the specified property of an object in $path to the value $value.
|
||||
$path is the full name of the property, including the object(s) in JS
|
||||
land it belongs to:
|
||||
|
||||
$js-E<gt>property_by_path("document.location.href", "abc");
|
||||
|
||||
This first creates the object "document" (if it doesn't exist already),
|
||||
then the object "document.location", then attaches the property "href"
|
||||
to it and sets it to "abc".
|
||||
|
||||
$getter and $setter are coderefs that will be called by the JavaScript
|
||||
engine when the respective property's value is requested or set:
|
||||
|
||||
sub getter {
|
||||
my($property_path, $value) = @_;
|
||||
print "$property_path has value $value\n";
|
||||
}
|
||||
|
||||
sub setter {
|
||||
my($property_path, $value) = @_;
|
||||
print "$property_path set to value $value\n";
|
||||
}
|
||||
|
||||
$js-E<gt>property_by_path("document.location.href", "abc",
|
||||
\&getter, \&setter);
|
||||
|
||||
If you leave out $getter and $setter, there's going to be no callbacks
|
||||
triggerd while the properity is set or queried. If you just want to
|
||||
specify a $setter, but no $getter, set the $getter to "undef".
|
||||
|
||||
$js->object_by_path($path, [$newobj])
|
||||
Get a pointer to an object with the path specified. Create it if it's
|
||||
not there yet. If $newobj is provided, the ref is used to bind the
|
||||
existing object to the name in $path.
|
||||
|
||||
$js->property_get($path)
|
||||
Fetch the property specified by the $path.
|
||||
|
||||
my $val = $js->property_get("document.location.href");
|
||||
|
||||
$js->eval($code)
|
||||
Runs the specified piece of <$code> in the JS engine. Afterwards,
|
||||
property values of objects previously defined will be available via
|
||||
"$j->property_get($path)" and the like.
|
||||
|
||||
my $rc = $js->eval("write('hello');");
|
||||
|
||||
The method returns 1 on success or else if there was an error in JS
|
||||
land. In case of an error, the JS error text will be available in $@.
|
||||
|
||||
SpiderMonkey Installation
|
||||
First, get the latest SpiderMonkey distribution from mozilla.org:
|
||||
http://www.mozilla.org/js/spidermonkey shows which releases are
|
||||
available. "js-1.5-rc3a.tar.gz" has been proven to work.
|
||||
|
||||
Untar it at the same directory level as you just untarred the
|
||||
"JavaScript::SpiderMonkey" distribution you're currently reading. So, if
|
||||
you're currently in "/my/path/JavaScript-SpiderMonkey-v.vv", do this:
|
||||
|
||||
cp js-1.5-rc3a.tar.gz /my/path
|
||||
cd /my/path
|
||||
tar zxfv js-1.5-rc3a.tar.gz
|
||||
|
||||
Then, compile the SpiderMonkey distribution, if you're on Linux, just
|
||||
use:
|
||||
|
||||
cd js/src
|
||||
make -f Makefile.ref
|
||||
|
||||
It's important that the js and JavaScript-SpiderMonkey-v.vv directories
|
||||
are at the same level:
|
||||
|
||||
[/my/path]$ ls
|
||||
JavaScript-SpiderMonkey-v.vv
|
||||
js
|
||||
js-1.5-rc3a.tar.gz
|
||||
[/my/path]$
|
||||
|
||||
(Note that you *can* untar the SpiderMonkey distribution elsewhere, but,
|
||||
if so, then you need to edit the setting of $JSLIBPATH in Makefile.PL).
|
||||
|
||||
Next, you need to copy the shared library file thus constructed (e.g.,
|
||||
libjs.so or js32.dll) to an appropriate directory on your library path.
|
||||
On Windows, this can also be the directory where the perl executable
|
||||
lives. On Unix, this has been shown to work without copying, but this
|
||||
way you need to keep the compiled binary in the "js" build directory
|
||||
forever. Copying "js/src/Your_OS_DBG.OBJ/libjs.so" to "/usr/local/lib"
|
||||
and making sure that "/usr/local/lib" is in your "LD_LIBRARY_PATH" seems
|
||||
to be safest bet.
|
||||
|
||||
Now, build JavaScript::SpiderMonkey in the standard way:
|
||||
|
||||
cd JavaScript-SpiderMonkey-v.vv
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
AUTHOR
|
||||
Mike Schilli, <m@perlmeister.com>
|
||||
|
||||
COPYRIGHT AND LICENSE
|
||||
Copyright 2002 by Mike Schilli
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
|
||||
/* Strucuture that keeps track of contexts */
|
||||
struct PJS_Context {
|
||||
/* total number of branch_operations the runtime went through in this context */
|
||||
int branch_count;
|
||||
|
||||
/* max number of branch_operations allowed in this context */
|
||||
int branch_max;
|
||||
};
|
||||
|
||||
typedef struct PJS_Context PJS_Context;
|
||||
|
||||
|
|
@ -1,707 +0,0 @@
|
|||
######################################################################
|
||||
package JavaScript::SpiderMonkey;
|
||||
######################################################################
|
||||
# Revision: $Revision: 1.8 $
|
||||
# Last Checkin: $Date: 2007/09/05 12:00:17 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
=head1 NAME
|
||||
|
||||
JavaScript::SpiderMonkey - Perl interface to the JavaScript Engine
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
|
||||
$js->init(); # Initialize Runtime/Context
|
||||
|
||||
# Define a perl callback for a new JavaScript function
|
||||
$js->function_set("print_to_perl", sub { print "@_\n"; });
|
||||
|
||||
# Create a new (nested) object and a property
|
||||
$js->property_by_path("document.location.href");
|
||||
|
||||
# Execute some code
|
||||
my $rc = $js->eval(q!
|
||||
document.location.href = append("http://", "www.aol.com");
|
||||
|
||||
print_to_perl("URL is ", document.location.href);
|
||||
|
||||
function append(first, second) {
|
||||
return first + second;
|
||||
}
|
||||
!);
|
||||
|
||||
# Get the value of a property set in JS
|
||||
my $url = $js->property_get("document.location.href");
|
||||
|
||||
$js->destroy();
|
||||
|
||||
=head1 INSTALL
|
||||
|
||||
JavaScript::SpiderMonkey requires Mozilla's readily compiled
|
||||
SpiderMonkey 1.5 distribution or better. Please check
|
||||
L<SpiderMonkey Installation>.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
JavaScript::SpiderMonkey is a Perl Interface to the
|
||||
SpiderMonkey JavaScript Engine. It is different from
|
||||
Claes Jacobsson's C<JavaScript.pm> in that it offers two
|
||||
different levels of access:
|
||||
|
||||
=over 4
|
||||
|
||||
=item [1]
|
||||
|
||||
A 1:1 mapping of the SpiderMonkey API to Perl
|
||||
|
||||
=item [2]
|
||||
|
||||
A more Perl-like API
|
||||
|
||||
=back
|
||||
|
||||
This document describes [2], for [1], please check C<SpiderMonkey.xs>.
|
||||
|
||||
=cut
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Data::Dumper;
|
||||
use Log::Log4perl qw(:easy);
|
||||
|
||||
require Exporter;
|
||||
require DynaLoader;
|
||||
|
||||
our $VERSION = '0.19';
|
||||
our @ISA = qw(Exporter DynaLoader);
|
||||
our %EXPORT_TAGS = ( 'all' => [ qw() ] );
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
our @EXPORT = qw();
|
||||
|
||||
bootstrap JavaScript::SpiderMonkey $VERSION;
|
||||
|
||||
our $GLOBAL;
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 new()
|
||||
|
||||
C<$js = JavaScript::SpiderMonkey-E<gt>new()> creates a new object to work with.
|
||||
To initialize the JS runtime, call C<$js-E<gt>init()> afterwards.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub new {
|
||||
##################################################
|
||||
my ($class) = @_;
|
||||
|
||||
my $self = {
|
||||
'runtime' => undef,
|
||||
'context' => undef,
|
||||
'global_object' => undef,
|
||||
'global_class' => undef,
|
||||
'objects' => { },
|
||||
};
|
||||
|
||||
# The function dispatcher is called from C and
|
||||
# doesn't have 'self'. Store it in a class var.
|
||||
# This means we can only have one instance of this
|
||||
# JavaScript::SpiderMonkey object. Ouch.
|
||||
our $GLOBAL = $self;
|
||||
|
||||
bless $self, $class;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>destroy()
|
||||
|
||||
C<$js-E<gt>destroy()> destroys the current runtime and frees up all memory.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub destroy {
|
||||
##################################################
|
||||
my ($self) = @_;
|
||||
JavaScript::SpiderMonkey::JS_DestroyContext($self->{context});
|
||||
JavaScript::SpiderMonkey::JS_DestroyRuntime($self->{runtime});
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>init()
|
||||
|
||||
C<$js-E<gt>init()> initializes the SpiderMonkey engine by creating a context,
|
||||
default classes and objects and adding an error reporter.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub init {
|
||||
##################################################
|
||||
my ($self) = @_;
|
||||
|
||||
$self->{runtime} =
|
||||
JavaScript::SpiderMonkey::JS_Init(1000000);
|
||||
$self->{context} =
|
||||
JavaScript::SpiderMonkey::JS_NewContext($self->{runtime}, 8192);
|
||||
$self->{global_class} =
|
||||
JavaScript::SpiderMonkey::JS_GlobalClass();
|
||||
$self->{global_object} =
|
||||
JavaScript::SpiderMonkey::JS_NewObject(
|
||||
$self->{context}, $self->{global_class},
|
||||
$self->{global_class}, $self->{global_class});
|
||||
|
||||
JavaScript::SpiderMonkey::JS_InitStandardClasses($self->{context},
|
||||
$self->{global_object});
|
||||
JavaScript::SpiderMonkey::JS_SetErrorReporter($self->{context});
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>array_by_path($name)
|
||||
|
||||
Creates an object of type I<Array>
|
||||
in the JS runtime:
|
||||
|
||||
$js->array_by_path("document.form");
|
||||
|
||||
will first create an object with the name C<document> (unless
|
||||
it exists already) and then define a property named C<form> to it,
|
||||
which is an object of type I<Array>. Therefore, in the JS code,
|
||||
you're going to be able define things like
|
||||
|
||||
document.form[0] = "value";
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub array_by_path {
|
||||
##################################################
|
||||
my ($self, $path) = @_;
|
||||
|
||||
my $array = JavaScript::SpiderMonkey::JS_NewArrayObject($self->{context});
|
||||
return $self->object_by_path($path, $array);
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>function_set($name, $funcref, [$obj])
|
||||
|
||||
Binds a Perl function provided as a coderef (C<$funcref>)
|
||||
to a newly created JS function
|
||||
named C<$name> in JS land.
|
||||
It's a real function (therefore bound to the global object) if C<$obj>
|
||||
is omitted. However, if C<$obj> is ref to
|
||||
a JS object (retrieved via C<$js-E<gt>object_by_path($path)> or the like),
|
||||
the function will be a I<method> of the specified object.
|
||||
|
||||
$js->function_set("write", sub { print @_ });
|
||||
# write("hello"); // In JS land
|
||||
|
||||
$obj = $j->object_by_path("navigator");
|
||||
$js->function_set("write", sub { print @_ }, $obj);
|
||||
# navigator.write("hello"); // In JS land
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub function_set {
|
||||
##################################################
|
||||
my ($self, $name, $func, $obj) = @_;
|
||||
|
||||
$obj ||= $self->{global_object}; # Defaults to global object
|
||||
|
||||
$self->{functions}->{${$obj}}->{$name} = $func;
|
||||
|
||||
return JavaScript::SpiderMonkey::JS_DefineFunction(
|
||||
$self->{context}, $obj, $name, 0, 0);
|
||||
}
|
||||
|
||||
##################################################
|
||||
sub function_dispatcher {
|
||||
##################################################
|
||||
my ($obj, $name, @args) = @_;
|
||||
|
||||
DEBUG "Dispatching function $obj-$name-@args";
|
||||
|
||||
our $GLOBAL;
|
||||
|
||||
## Find the path for this object.
|
||||
my $found = 0;
|
||||
foreach( keys( %{$GLOBAL->{objects}} ) ){
|
||||
if( ${$GLOBAL->{objects}->{$_}} eq $obj &&
|
||||
exists( $GLOBAL->{functions}->{$obj}->{$name} ) ){
|
||||
DEBUG "Function found";
|
||||
$found = 1;
|
||||
}
|
||||
}
|
||||
$obj = ${$GLOBAL->{global_object}} unless $found;
|
||||
|
||||
if(! exists $GLOBAL->{functions}->{$obj}->{$name}) {
|
||||
LOGDIE "Dispatcher: Can't find mapping for function $obj" .
|
||||
${$GLOBAL->{global_object}} . " '$name'";
|
||||
}
|
||||
|
||||
my $val = $GLOBAL->{functions}->{$obj}->{$name}->(@args);
|
||||
|
||||
DEBUG "retval=$val";
|
||||
|
||||
return $val;
|
||||
}
|
||||
|
||||
##################################################
|
||||
sub getsetter_dispatcher {
|
||||
##################################################
|
||||
my ($obj, $propname, $what, $value) = @_;
|
||||
|
||||
our $GLOBAL;
|
||||
|
||||
DEBUG "Dispatcher obj=$obj";
|
||||
DEBUG "prop=$propname what=$what value=$value";
|
||||
|
||||
DEBUG "GETTING properties/$obj/$propname/$what";
|
||||
|
||||
if(exists $GLOBAL->{properties}->{$obj}->{$propname}->{$what}) {
|
||||
my $entry = $GLOBAL->{properties}->{$obj}->{$propname}->{$what};
|
||||
my $path = $entry->{path};
|
||||
DEBUG "DISPATCHING for object $path ($what)";
|
||||
$entry->{callback}->($path, $value);
|
||||
} else {
|
||||
DEBUG "properties/$obj/$propname/$what doesn't exist";
|
||||
}
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>array_set_element($obj, $idx, $val)
|
||||
|
||||
Sets the element of the array C<$obj>
|
||||
at index position C<$idx> to the value C<$val>.
|
||||
C<$obj> is a reference to an object of type array
|
||||
(retrieved via C<$js-E<gt>object_by_path($path)> or the like).
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub array_set_element {
|
||||
##################################################
|
||||
my ($self, $obj, $idx, $val) = @_;
|
||||
|
||||
DEBUG "Setting $idx of $obj ($self->{context}) to $val";
|
||||
JavaScript::SpiderMonkey::JS_SetElement(
|
||||
$self->{context}, $obj, $idx, $val);
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>array_set_element_as_object($obj, $idx, $elobj)
|
||||
|
||||
Sets the element of the array C<$obj>
|
||||
at index position C<$idx> to the object C<$elobj>
|
||||
(both C<$obj> and C<$elobj> have been retrieved
|
||||
via C<$js-E<gt>object_by_path($path)> or the like).
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub array_set_element_as_object {
|
||||
##################################################
|
||||
my ($self, $obj, $idx, $elobj) = @_;
|
||||
|
||||
JavaScript::SpiderMonkey::JS_SetElementAsObject(
|
||||
$self->{context}, $obj, $idx, $elobj);
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>array_get_element($obj, $idx)
|
||||
|
||||
Gets the value of of the element at index C<$idx>
|
||||
of the object of type Array C<$obj>.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub array_get_element {
|
||||
##################################################
|
||||
my ($self, $obj, $idx) = @_;
|
||||
|
||||
my $rc = JavaScript::SpiderMonkey::JS_GetElement(
|
||||
$self->{context}, $obj, $idx);
|
||||
|
||||
DEBUG("Getting $idx of $obj ($self->{context}): ",
|
||||
($rc || "undef"));
|
||||
|
||||
return $rc;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>property_by_path($path, $value, [$getter], [$setter])
|
||||
|
||||
Sets the specified property of an object in C<$path> to the
|
||||
value C<$value>. C<$path> is the full name of the property,
|
||||
including the object(s) in JS land it belongs to:
|
||||
|
||||
$js-E<gt>property_by_path("document.location.href", "abc");
|
||||
|
||||
This first creates the object C<document> (if it doesn't exist already),
|
||||
then the object C<document.location>, then attaches the property
|
||||
C<href> to it and sets it to C<"abc">.
|
||||
|
||||
C<$getter> and C<$setter> are coderefs that will be called by
|
||||
the JavaScript engine when the respective property's value is
|
||||
requested or set:
|
||||
|
||||
sub getter {
|
||||
my($property_path, $value) = @_;
|
||||
print "$property_path has value $value\n";
|
||||
}
|
||||
|
||||
sub setter {
|
||||
my($property_path, $value) = @_;
|
||||
print "$property_path set to value $value\n";
|
||||
}
|
||||
|
||||
$js-E<gt>property_by_path("document.location.href", "abc",
|
||||
\&getter, \&setter);
|
||||
|
||||
If you leave out C<$getter> and C<$setter>, there's going to be no
|
||||
callbacks triggerd while the properity is set or queried.
|
||||
If you just want to specify a C<$setter>, but no C<$getter>,
|
||||
set the C<$getter> to C<undef>.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub property_by_path {
|
||||
##################################################
|
||||
my ($self, $path, $value, $getter, $setter) = @_;
|
||||
|
||||
DEBUG "Retrieve/Create property $path";
|
||||
|
||||
(my $opath = $path) =~ s/\.[^.]+$//;
|
||||
my $obj = $self->object_by_path($opath);
|
||||
unless(defined $obj) {
|
||||
LOGWARN "No object pointer found to $opath";
|
||||
return undef;
|
||||
}
|
||||
|
||||
DEBUG "$opath: obj=$obj";
|
||||
|
||||
$value = 'undef' unless defined $value;
|
||||
|
||||
DEBUG "Define property $self->{context}, $obj, $path, $value";
|
||||
|
||||
(my $property = $path) =~ s/.*\.//;
|
||||
|
||||
my $prop = JavaScript::SpiderMonkey::JS_DefineProperty(
|
||||
$self->{context}, $obj, $property, $value);
|
||||
|
||||
DEBUG "SETTING properties/$$obj/$property/getter";
|
||||
if($getter) {
|
||||
# Store it under the original C pointer's value. We get
|
||||
# back a PTRREF from JS_DefineObject, but we need the
|
||||
# original value for the callback dispatcher.
|
||||
$self->{properties}->{$$obj}->{$property}->{getter}->{callback}
|
||||
= $getter;
|
||||
$self->{properties}->{$$obj}->{$property}->{getter}->{path} = $path;
|
||||
}
|
||||
|
||||
if($setter) {
|
||||
$self->{properties}->{$$obj}->{$property}->{setter}->{callback}
|
||||
= $setter;
|
||||
$self->{properties}->{$$obj}->{$property}->{setter}->{path} = $path;
|
||||
}
|
||||
|
||||
return $prop;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>object_by_path($path, [$newobj])
|
||||
|
||||
Get a pointer to an object with the path
|
||||
specified. Create it if it's not there yet.
|
||||
If C<$newobj> is provided, the ref is used to
|
||||
bind the existing object to the name in C<$path>.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub object_by_path {
|
||||
##################################################
|
||||
my ($self, $path, $newobj) = @_;
|
||||
|
||||
DEBUG "Retrieve/Create object $path";
|
||||
|
||||
DEBUG "Got a ", defined $newobj ? "predefined" : "undefined",
|
||||
" object";
|
||||
|
||||
my $obj = $self->{global_object};
|
||||
|
||||
my @parts = split /\./, $path;
|
||||
my $full = "";
|
||||
|
||||
return undef unless @parts;
|
||||
|
||||
while(@parts >= 1) {
|
||||
my $part = shift @parts;
|
||||
$full .= "." if $full;
|
||||
$full .= "$part";
|
||||
|
||||
if(exists $self->{objects}->{$full}) {
|
||||
$obj = $self->{objects}->{$full};
|
||||
DEBUG "Object $full exists: $obj";
|
||||
} else {
|
||||
my $gobj = $self->{global_object};
|
||||
if(defined $newobj and $path eq $full) {
|
||||
DEBUG "Setting $path to predefined object";
|
||||
$obj = JavaScript::SpiderMonkey::JS_DefineObject(
|
||||
$self->{context}, $obj, $part,
|
||||
JavaScript::SpiderMonkey::JS_GetClass($self->{context}, $newobj),
|
||||
$newobj);
|
||||
} else {
|
||||
$obj = JavaScript::SpiderMonkey::JS_DefineObject(
|
||||
$self->{context}, $obj, $part,
|
||||
$self->{global_class}, $self->{global_object});
|
||||
}
|
||||
$self->{objects}->{$full} = $obj;
|
||||
DEBUG "Object $full created: $obj";
|
||||
}
|
||||
}
|
||||
|
||||
return $obj;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>property_get($path)
|
||||
|
||||
Fetch the property specified by the C<$path>.
|
||||
|
||||
my $val = $js->property_get("document.location.href");
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub property_get {
|
||||
##################################################
|
||||
my ($self, $string) = @_;
|
||||
|
||||
my($path, $property) = ($string =~ /(.*)\.([^\.]+)$/);
|
||||
|
||||
if(!exists $self->{objects}->{$path}) {
|
||||
LOGWARN "Cannot find object $path via SpiderMonkey";
|
||||
return;
|
||||
}
|
||||
|
||||
DEBUG "Get property $self->{objects}->{$path}, $property";
|
||||
|
||||
return JavaScript::SpiderMonkey::JS_GetProperty(
|
||||
$self->{context}, $self->{objects}->{$path},
|
||||
$property);
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>eval($code)
|
||||
|
||||
Runs the specified piece of <$code> in the JS engine.
|
||||
Afterwards, property values of objects previously defined
|
||||
will be available via C<$j-E<gt>property_get($path)>
|
||||
and the like.
|
||||
|
||||
my $rc = $js->eval("write('hello');");
|
||||
|
||||
The method returns C<1> on success or else if
|
||||
there was an error in JS land. In case of an error, the JS
|
||||
error text will be available in C<$@>.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub eval {
|
||||
##################################################
|
||||
my ($self, $script) = @_;
|
||||
|
||||
return 1 unless defined $script;
|
||||
|
||||
my $ok =
|
||||
JavaScript::SpiderMonkey::JS_EvaluateScript(
|
||||
$self->{context},
|
||||
$self->{global_object},
|
||||
$script,
|
||||
$] > 5.007 ? bytes::length($script) : length($script),
|
||||
"Perl",
|
||||
0);
|
||||
|
||||
return $ok;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>ret_eval($code)
|
||||
|
||||
Runs the specified piece of <$code> in the JS engine.
|
||||
Differs from eval because it returns the results of
|
||||
the last executed expression from the JS context.
|
||||
|
||||
my $value = $js->ret_eval("2+2");
|
||||
|
||||
The method returns the result of the last evaluated
|
||||
JS expression. In case of an error, the JS
|
||||
error text will be available in C<$@>.
|
||||
|
||||
=cut
|
||||
|
||||
##################################################
|
||||
sub ret_eval {
|
||||
##################################################
|
||||
my ($self, $script) = @_;
|
||||
|
||||
return 1 unless defined $script;
|
||||
|
||||
no warnings 'uninitialized'; #Silence a spurious undef warning I can't track down.
|
||||
my $ok =
|
||||
JavaScript::SpiderMonkey::JS_RetEvaluateScript(
|
||||
$self->{context},
|
||||
$self->{global_object},
|
||||
$script,
|
||||
#$] > 5.007 ? bytes::length($script) : length($script),
|
||||
length($script),
|
||||
"Perl",
|
||||
0);
|
||||
|
||||
return $ok;
|
||||
}
|
||||
|
||||
##################################################
|
||||
|
||||
=head2 $js-E<gt>set_max_branch_operations($max_branch_operations)
|
||||
|
||||
Set the maximum number of allowed branch operations. This protects
|
||||
against infinite loops and guarantees that the eval operation
|
||||
will terminate.
|
||||
|
||||
=cut
|
||||
##################################################
|
||||
sub set_max_branch_operations {
|
||||
##################################################
|
||||
my ($self, $max_branch_operations) = @_;
|
||||
JavaScript::SpiderMonkey::JS_SetMaxBranchOperations($self->{context}, $max_branch_operations);
|
||||
}
|
||||
|
||||
##################################################
|
||||
sub dump {
|
||||
##################################################
|
||||
my ($self) = @_;
|
||||
|
||||
Data::Dumper::Dumper($self->{objects});
|
||||
}
|
||||
|
||||
##################################################
|
||||
sub debug_enabled {
|
||||
##################################################
|
||||
my $logger = Log::Log4perl::get_logger("JavaScript::SpiderMonkey");
|
||||
if(Log::Log4perl->initialized() and $logger->is_debug()) {
|
||||
# print "DEBUG IS ENABLED\n";
|
||||
return 1;
|
||||
} else {
|
||||
# print "DEBUG IS DISABLED\n";
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 SpiderMonkey Installation
|
||||
|
||||
First, get the latest SpiderMonkey distribution from mozilla.org:
|
||||
http://www.mozilla.org/js/spidermonkey shows which releases are available.
|
||||
C<js-1.6.tar.gz> has been proven to work.
|
||||
|
||||
Untar it at the same directory level as you just untarred the
|
||||
C<JavaScript::SpiderMonkey> distribution you're currently reading.
|
||||
So, if you're currently in C</my/path/JavaScript-SpiderMonkey-v.vv>, do
|
||||
this:
|
||||
|
||||
cp js-1.6.tar.gz /my/path
|
||||
cd /my/path
|
||||
tar zxfv js-1.6.tar.gz
|
||||
|
||||
Then, compile the SpiderMonkey distribution, if you're on Linux,
|
||||
just use:
|
||||
|
||||
cd js/src
|
||||
make -f Makefile.ref
|
||||
|
||||
It's important that the js and JavaScript-SpiderMonkey-v.vv directories
|
||||
are at the same level:
|
||||
|
||||
[/my/path]$ ls
|
||||
JavaScript-SpiderMonkey-v.vv
|
||||
js
|
||||
js-1.6.tar.gz
|
||||
[/my/path]$
|
||||
|
||||
(Note that you *can* untar the SpiderMonkey distribution elsewhere,
|
||||
but, if so, then you need to edit the setting of $JSLIBPATH in Makefile.PL).
|
||||
|
||||
Next, you need to copy the shared library file thus constructed
|
||||
(e.g., libjs.so or js32.dll) to an appropriate directory on your library path.
|
||||
On Windows, this can also be the directory where the perl executable
|
||||
lives. On Unix, this has been shown to work without copying, but this way
|
||||
you need to keep the compiled binary in the C<js> build directory forever.
|
||||
Copying
|
||||
C<js/src/Your_OS_DBG.OBJ/libjs.so> to C</usr/local/lib> and
|
||||
making sure that C</usr/local/lib> is in your C<LD_LIBRARY_PATH>
|
||||
seems to be safest bet.
|
||||
|
||||
Now, build JavaScript::SpiderMonkey in the standard way:
|
||||
|
||||
cd JavaScript-SpiderMonkey-v.vv
|
||||
perl Makefile.PL
|
||||
make
|
||||
make test
|
||||
make install
|
||||
|
||||
=head1 E4X SUPPORT
|
||||
|
||||
To build JavaScript-SpiderMonkey with E4X (ECMAScript for XML) support:
|
||||
|
||||
perl Makefile.PL -E4X
|
||||
|
||||
Please note that E4X support is only supported since SpiderMonkey release 1.6.
|
||||
|
||||
=head1 THREAD SAFETY
|
||||
|
||||
To build JavaScript-SpiderMonkey when using a thread safe version of SpiderMonkey:
|
||||
|
||||
perl Makefile.PL -JS_THREADSAFE
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
Mike Schilli, <m at perlmeister dot com>
|
||||
Thomas Busch, <tbusch at cpan dot org> (current maintainer)
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (c) 2002-2005 Mike Schilli
|
||||
Copyright (c) 2006-2007 Thomas Busch
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
|
@ -1,824 +0,0 @@
|
|||
/* --------------------------------------------------------------------- */
|
||||
/* SpiderMonkey.xs -- Perl Interface to the SpiderMonkey JavaScript */
|
||||
/* implementation. */
|
||||
/* */
|
||||
/* Revision: $Revision: 1.6 $ */
|
||||
/* Last Checkin: $Date: 2007/06/08 19:03:08 $ */
|
||||
/* By: $Author: thomas_busch $ */
|
||||
/* */
|
||||
/* Author: Mike Schilli mschilli1@aol.com, 2001 */
|
||||
/* --------------------------------------------------------------------- */
|
||||
|
||||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
#include "jsapi.h"
|
||||
#include "SpiderMonkey.h"
|
||||
|
||||
#ifdef _MSC_VER
|
||||
/* As suggested in https://rt.cpan.org/Ticket/Display.html?id=6984 */
|
||||
#define snprintf _snprintf
|
||||
#endif
|
||||
|
||||
/* JSRuntime needs this global class */
|
||||
static
|
||||
JSClass global_class = {
|
||||
"Global", 0,
|
||||
JS_PropertyStub, JS_PropertyStub, JS_PropertyStub, JS_PropertyStub,
|
||||
JS_EnumerateStub, JS_ResolveStub, JS_ConvertStub, JS_FinalizeStub
|
||||
};
|
||||
|
||||
static int Debug = 0;
|
||||
|
||||
static int max_branch_operations = 0;
|
||||
|
||||
/*==================================*/
|
||||
/* Begin Dirty Hackery */
|
||||
/*==================================*/
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
int obj_to_str(
|
||||
JSContext *cx,
|
||||
JSObject *obj,
|
||||
SV *perl_str
|
||||
/* --------------------------------------------------------------------- */
|
||||
) {
|
||||
JSIdArray *fields = JS_Enumerate( cx, obj );
|
||||
int i = 0;
|
||||
jsval property;
|
||||
|
||||
sv_catpvn( perl_str, "{ ", 2 );
|
||||
/*printf("OBJ_TO_STR\n");
|
||||
printf("Length: %i\n", fields->length);*/
|
||||
|
||||
for( i = 0; i < fields->length; i++ )
|
||||
{
|
||||
jsid id = fields->vector[i];
|
||||
jsval id_val;
|
||||
char *prop_name;
|
||||
|
||||
JS_IdToValue( cx, id, &id_val );
|
||||
prop_name = JS_GetStringBytes(JS_ValueToString(cx, id_val));
|
||||
JS_GetProperty( cx, obj, prop_name, &property );
|
||||
|
||||
/* printf("Adding %s to pv\n", prop_name); */
|
||||
sv_catpvn( perl_str, prop_name, strlen( prop_name ) );
|
||||
sv_catpvn( perl_str, ": ", 2 );
|
||||
/* printf( "Str: %s\n", SvPVbyte_nolen( perl_str ) ); */
|
||||
|
||||
if( JSVAL_IS_OBJECT( property ) )
|
||||
{
|
||||
JSObject *prop_obj;
|
||||
JS_ValueToObject( cx, property, &prop_obj );
|
||||
obj_to_str( cx, prop_obj, perl_str );
|
||||
}
|
||||
else
|
||||
{
|
||||
JSString *prop_str = JS_ValueToString( cx, property );
|
||||
sv_catpvn( perl_str, JS_GetStringBytes( prop_str ), JS_GetStringLength( prop_str ) );
|
||||
/*sv_catpvn( perl_str, " ", 1 );*/
|
||||
}
|
||||
|
||||
if( i < ( fields->length - 1 ) )
|
||||
{
|
||||
sv_catpvn( perl_str, ", ", 2 );
|
||||
}
|
||||
}
|
||||
|
||||
sv_catpvn( perl_str, "}", 1 );
|
||||
JS_DestroyIdArray( cx, fields );
|
||||
return 1;
|
||||
}
|
||||
/*==================================*/
|
||||
/* End Dirty Hackery */
|
||||
/*==================================*/
|
||||
|
||||
/* It's kinda silly that we have to replicate this for getters and setters,
|
||||
* but there doesn't seem to be a way to distinguish between getters
|
||||
* and setters if we use the same function. (Somewhere I read in a
|
||||
* usenet posting there's something like IS_ASSIGN, but this doesn't
|
||||
* seem to be in SpiderMonkey 1.5).
|
||||
*/
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
JSBool getsetter_dispatcher(
|
||||
JSContext *cx,
|
||||
JSObject *obj,
|
||||
jsval id,
|
||||
jsval *vp,
|
||||
char *what
|
||||
/* --------------------------------------------------------------------- */
|
||||
) {
|
||||
dSP;
|
||||
|
||||
/* Call back into perl */
|
||||
ENTER ;
|
||||
SAVETMPS ;
|
||||
PUSHMARK(SP);
|
||||
/* A somewhat nasty trick: Since JS_DefineObject() down below
|
||||
* returns a *JS_Object, which is typemapped as T_PTRREF,
|
||||
* and which is a reference (!) pointing to the real C pointer,
|
||||
* we need to brutally obtain the obj's address by casting
|
||||
* it to an int and forming a scalar out of it.
|
||||
* On the other hand, when Spidermonkey.pm stores the
|
||||
* object's setters/getters, it will dereference
|
||||
* what it gets from JS_DefineObject() (therefore
|
||||
* obtain the object's address in memory) to index its
|
||||
* hash table.
|
||||
* I hope all reasonable machines can hold an address in
|
||||
* an int.
|
||||
*/
|
||||
XPUSHs(sv_2mortal(newSViv((int)obj)));
|
||||
XPUSHs(sv_2mortal(newSVpv(JS_GetStringBytes(JSVAL_TO_STRING(id)), 0)));
|
||||
XPUSHs(sv_2mortal(newSVpv(what, 0)));
|
||||
XPUSHs(sv_2mortal(newSVpv(JS_GetStringBytes(JSVAL_TO_STRING(*vp)), 0)));
|
||||
PUTBACK;
|
||||
call_pv("JavaScript::SpiderMonkey::getsetter_dispatcher", G_DISCARD);
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
|
||||
return JS_TRUE;
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
JSBool getter_dispatcher(
|
||||
JSContext *cx,
|
||||
JSObject *obj,
|
||||
jsval id,
|
||||
jsval *vp
|
||||
/* --------------------------------------------------------------------- */
|
||||
) {
|
||||
return getsetter_dispatcher(cx, obj, id, vp, "getter");
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
JSBool setter_dispatcher(
|
||||
JSContext *cx,
|
||||
JSObject *obj,
|
||||
jsval id,
|
||||
jsval *vp
|
||||
/* --------------------------------------------------------------------- */
|
||||
) {
|
||||
return getsetter_dispatcher(cx, obj, id, vp, "setter");
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
int debug_enabled(
|
||||
/* --------------------------------------------------------------------- */
|
||||
) {
|
||||
dSP;
|
||||
|
||||
int enabled = 0;
|
||||
int count = 0;
|
||||
|
||||
/* Call back into perl */
|
||||
ENTER ;
|
||||
SAVETMPS ;
|
||||
PUTBACK;
|
||||
count = call_pv("JavaScript::SpiderMonkey::debug_enabled", G_SCALAR);
|
||||
if(count == 1) {
|
||||
if(POPi == 1) {
|
||||
enabled = 1;
|
||||
}
|
||||
}
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
|
||||
return enabled;
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
static JSBool
|
||||
FunctionDispatcher(JSContext *cx, JSObject *obj, uintN argc,
|
||||
jsval *argv, jsval *rval) {
|
||||
/* --------------------------------------------------------------------- */
|
||||
dSP;
|
||||
SV *sv;
|
||||
char *n_jstr;
|
||||
int n_jnum;
|
||||
double n_jdbl;
|
||||
unsigned i;
|
||||
int count;
|
||||
JSFunction *fun;
|
||||
fun = JS_ValueToFunction(cx, argv[-2]);
|
||||
|
||||
/* printf("Function %s received %d arguments\n",
|
||||
(char *) JS_GetFunctionName(fun),
|
||||
(int) argc); */
|
||||
|
||||
/* Call back into perl */
|
||||
ENTER ;
|
||||
SAVETMPS ;
|
||||
PUSHMARK(SP);
|
||||
XPUSHs(sv_2mortal(newSViv((int)obj)));
|
||||
XPUSHs(sv_2mortal(newSVpv(
|
||||
JS_GetFunctionName(fun), 0)));
|
||||
for(i=0; i<argc; i++) {
|
||||
XPUSHs(sv_2mortal(newSVpv(
|
||||
JS_GetStringBytes(JS_ValueToString(cx, argv[i])), 0)));
|
||||
}
|
||||
PUTBACK;
|
||||
count = call_pv("JavaScript::SpiderMonkey::function_dispatcher", G_SCALAR);
|
||||
SPAGAIN;
|
||||
|
||||
if(Debug)
|
||||
fprintf(stderr, "DEBUG: Count is %d\n", count);
|
||||
|
||||
if( count > 0) {
|
||||
sv = POPs;
|
||||
if(SvROK(sv)) {
|
||||
/* Im getting a perl reference here, the user
|
||||
* seems to want to send a perl object to jscript
|
||||
* ok, we will do it, although it seems like a painful
|
||||
* thing to me.
|
||||
*/
|
||||
|
||||
if(Debug)
|
||||
fprintf(stderr, "DEBUG: %lx is a ref!\n", (long) sv);
|
||||
*rval = OBJECT_TO_JSVAL(SvIV(SvRV(sv)));
|
||||
}
|
||||
else if(SvIOK(sv)) {
|
||||
/* It appears that we have been sent an int return
|
||||
* value. Thats fine we can give javascript an int
|
||||
*/
|
||||
n_jnum=SvIV(sv);
|
||||
if(Debug)
|
||||
fprintf(stderr, "DEBUG: %lx is an int (%d)\n", (long) sv,n_jnum);
|
||||
*rval = INT_TO_JSVAL(n_jnum);
|
||||
} else if(SvNOK(sv)) {
|
||||
/* It appears that we have been sent an double return
|
||||
* value. Thats fine we can give javascript an double
|
||||
*/
|
||||
n_jdbl=SvNV(sv);
|
||||
|
||||
if(Debug)
|
||||
fprintf(stderr, "DEBUG: %lx is a double(%f)\n", (long) sv,n_jdbl);
|
||||
*rval = DOUBLE_TO_JSVAL(JS_NewDouble(cx, n_jdbl));
|
||||
} else if(SvPOK(sv)) {
|
||||
n_jstr = SvPV(sv, PL_na);
|
||||
//warn("DEBUG: %s (%d)\n", n_jstr);
|
||||
*rval = STRING_TO_JSVAL(JS_NewStringCopyZ(cx, n_jstr));
|
||||
}
|
||||
}
|
||||
|
||||
PUTBACK;
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
|
||||
return JS_TRUE;
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
static void
|
||||
ErrorReporter(JSContext *cx, const char *message, JSErrorReport *report) {
|
||||
/* --------------------------------------------------------------------- */
|
||||
char msg[400];
|
||||
snprintf(msg, sizeof(msg),
|
||||
"Error: %s at line %d: %s", message, report->lineno,
|
||||
report->linebuf);
|
||||
sv_setpv(get_sv("@", TRUE), msg);
|
||||
}
|
||||
|
||||
/* --------------------------------------------------------------------- */
|
||||
static JSBool
|
||||
BranchHandler(JSContext *cx, JSScript *script) {
|
||||
/* --------------------------------------------------------------------- */
|
||||
PJS_Context* pcx = (PJS_Context*) JS_GetContextPrivate(cx);
|
||||
|
||||
pcx->branch_count++;
|
||||
if (pcx->branch_count > pcx->branch_max) {
|
||||
return JS_FALSE;
|
||||
} else {
|
||||
return JS_TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
MODULE = JavaScript::SpiderMonkey PACKAGE = JavaScript::SpiderMonkey
|
||||
PROTOTYPES: DISABLE
|
||||
|
||||
######################################################################
|
||||
char *
|
||||
JS_GetImplementationVersion()
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
RETVAL = (char *) JS_GetImplementationVersion();
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSRuntime *
|
||||
JS_NewRuntime(maxbytes)
|
||||
int maxbytes
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSRuntime *rt;
|
||||
CODE:
|
||||
{
|
||||
rt = JS_NewRuntime(maxbytes);
|
||||
if(!rt) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = rt;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_DestroyRuntime(rt)
|
||||
JSRuntime *rt
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
JS_DestroyRuntime(rt);
|
||||
RETVAL = 0;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSRuntime *
|
||||
JS_Init(maxbytes)
|
||||
int maxbytes
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSRuntime *rt;
|
||||
CODE:
|
||||
{
|
||||
rt = JS_Init(maxbytes);
|
||||
if(!rt) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
/* Replace this by Debug = debug_enabled(); once
|
||||
* Log::Log4perl 0.47 is out */
|
||||
Debug = 0;
|
||||
RETVAL = rt;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSContext *
|
||||
JS_NewContext(rt, stack_chunk_size)
|
||||
JSRuntime *rt
|
||||
int stack_chunk_size
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSContext *cx;
|
||||
CODE:
|
||||
{
|
||||
PJS_Context* pcx;
|
||||
cx = JS_NewContext(rt, stack_chunk_size);
|
||||
if(!cx) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
#ifdef E4X
|
||||
JS_SetOptions(cx,JSOPTION_XML);
|
||||
#endif
|
||||
|
||||
Newz(1, pcx, 1, PJS_Context);
|
||||
JS_SetContextPrivate(cx, (void *)pcx);
|
||||
|
||||
RETVAL = cx;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_DestroyContext(cx)
|
||||
JSContext *cx;
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
JS_DestroyContext(cx);
|
||||
Safefree(JS_GetContextPrivate(cx));
|
||||
RETVAL = 0;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSObject *
|
||||
JS_NewObject(cx, class, proto, parent)
|
||||
JSContext * cx
|
||||
JSClass * class
|
||||
JSObject * proto
|
||||
JSObject * parent
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSObject *obj;
|
||||
CODE:
|
||||
{
|
||||
obj = JS_NewObject(cx, class, NULL, NULL);
|
||||
if(!obj) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = obj;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSObject *
|
||||
JS_InitClass(cx, iobj, parent_proto, clasp, constructor, nargs, ps, fs, static_ps, static_fs)
|
||||
JSContext * cx
|
||||
JSObject *iobj
|
||||
JSObject *parent_proto
|
||||
JSClass *clasp
|
||||
JSNative constructor
|
||||
int nargs
|
||||
JSPropertySpec *ps
|
||||
JSFunctionSpec *fs
|
||||
JSPropertySpec *static_ps
|
||||
JSFunctionSpec *static_fs
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSObject *obj;
|
||||
uintN na;
|
||||
INIT:
|
||||
na = (uintN) nargs;
|
||||
CODE:
|
||||
{
|
||||
obj = JS_InitClass(cx, iobj, parent_proto, clasp,
|
||||
constructor, nargs, ps, fs, static_ps,
|
||||
static_fs);
|
||||
if(!obj) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = obj;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSClass *
|
||||
JS_GlobalClass()
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSClass *gc;
|
||||
CODE:
|
||||
{
|
||||
gc = &global_class;
|
||||
RETVAL = gc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
void
|
||||
JS_ForceLatest(cx)
|
||||
JSContext * cx
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
JS_SetVersion(cx, JSVERSION_LATEST);
|
||||
}
|
||||
|
||||
######################################################################
|
||||
char*
|
||||
JS_RetEvaluateScript(cx, gobj, script, length, filename, lineno)
|
||||
JSContext * cx
|
||||
JSObject * gobj
|
||||
char * script
|
||||
int length
|
||||
char * filename
|
||||
int lineno
|
||||
######################################################################
|
||||
PREINIT:
|
||||
uintN len;
|
||||
uintN ln;
|
||||
int rc;
|
||||
jsval jsval;
|
||||
JSString *js_string;
|
||||
char *return_string;
|
||||
INIT:
|
||||
len = (uintN) length;
|
||||
ln = (uintN) lineno;
|
||||
CODE:
|
||||
{
|
||||
rc = JS_EvaluateScript(cx, gobj, script, len, filename,
|
||||
ln, &jsval);
|
||||
if(!rc) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
|
||||
if( JSVAL_IS_OBJECT(jsval) )
|
||||
{
|
||||
SV* sv = NEWSV(5,10);
|
||||
JSObject *obj;
|
||||
JS_ValueToObject( cx, jsval, &obj );
|
||||
obj_to_str(cx,obj,sv);
|
||||
RETVAL = SvPVbyte_nolen( sv );
|
||||
}
|
||||
|
||||
else
|
||||
{
|
||||
js_string = JS_ValueToString(cx, jsval);
|
||||
return_string = JS_GetStringBytes(js_string);
|
||||
RETVAL = return_string;
|
||||
}
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_EvaluateScript(cx, gobj, script, length, filename, lineno)
|
||||
JSContext * cx
|
||||
JSObject * gobj
|
||||
char * script
|
||||
int length
|
||||
char * filename
|
||||
int lineno
|
||||
######################################################################
|
||||
PREINIT:
|
||||
uintN len;
|
||||
uintN ln;
|
||||
int rc;
|
||||
jsval jsval;
|
||||
INIT:
|
||||
len = (uintN) length;
|
||||
ln = (uintN) lineno;
|
||||
CODE:
|
||||
{
|
||||
rc = JS_EvaluateScript(cx, gobj, script, len, filename,
|
||||
ln, &jsval);
|
||||
if(!rc) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_InitStandardClasses(cx, gobj)
|
||||
JSContext * cx
|
||||
JSObject * gobj
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
CODE:
|
||||
{
|
||||
rc = JS_InitStandardClasses(cx, gobj);
|
||||
if(!rc) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = (int) rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_DefineFunction(cx, obj, name, nargs, flags)
|
||||
JSContext * cx
|
||||
JSObject * obj
|
||||
char * name
|
||||
int nargs
|
||||
int flags
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSFunction *rc;
|
||||
CODE:
|
||||
{
|
||||
rc = JS_DefineFunction(cx, obj,
|
||||
(const char *) name, FunctionDispatcher,
|
||||
(uintN) nargs, (uintN) flags);
|
||||
if(!rc) {
|
||||
XSRETURN_UNDEF;
|
||||
}
|
||||
RETVAL = (int) rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_SetErrorReporter(cx)
|
||||
JSContext * cx
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
JS_SetErrorReporter(cx, ErrorReporter);
|
||||
RETVAL = 0;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
JSObject *
|
||||
JS_DefineObject(cx, obj, name, class, proto)
|
||||
JSContext * cx
|
||||
JSObject * obj
|
||||
char * name
|
||||
JSClass * class
|
||||
JSObject * proto
|
||||
######################################################################
|
||||
PREINIT:
|
||||
SV *sv = sv_newmortal();
|
||||
CODE:
|
||||
{
|
||||
RETVAL = JS_DefineObject(cx, obj, name, class, proto, 0);
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_DefineProperty(cx, obj, name, value)
|
||||
JSContext * cx
|
||||
JSObject * obj
|
||||
char * name
|
||||
char * value
|
||||
#JSPropertyOp getter
|
||||
#JSPropertyOp setter
|
||||
#uintN flags
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
JSString *str;
|
||||
CODE:
|
||||
{
|
||||
str = JS_NewStringCopyZ(cx, value);
|
||||
|
||||
/* This implementation is somewhat sub-optimal, since it
|
||||
* calls back into perl even if no getters/setters have
|
||||
* been defined. The necessity for a callback is determined
|
||||
* at the perl level, where there's a data structure mapping
|
||||
* out each object's properties and their getter/setter settings.
|
||||
*/
|
||||
rc = JS_DefineProperty(cx, obj, name, STRING_TO_JSVAL(str),
|
||||
getter_dispatcher, setter_dispatcher, 0);
|
||||
RETVAL = (int) rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
void
|
||||
JS_GetProperty(cx, obj, name)
|
||||
JSContext * cx
|
||||
JSObject * obj
|
||||
char * name
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
jsval vp;
|
||||
JSString *str;
|
||||
SV *sv = sv_newmortal();
|
||||
PPCODE:
|
||||
{
|
||||
rc = JS_TRUE;
|
||||
rc = JS_GetProperty(cx, obj, name, &vp);
|
||||
if(rc) {
|
||||
str = JS_ValueToString(cx, vp);
|
||||
if(strcmp(JS_GetStringBytes(str), "undefined") == 0) {
|
||||
sv = &PL_sv_undef;
|
||||
} else {
|
||||
sv_setpv(sv, JS_GetStringBytes(str));
|
||||
}
|
||||
} else {
|
||||
sv = &PL_sv_undef;
|
||||
}
|
||||
XPUSHs(sv);
|
||||
}
|
||||
|
||||
######################################################################
|
||||
JSObject *
|
||||
JS_NewArrayObject(cx)
|
||||
JSContext * cx
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSObject *rc;
|
||||
CODE:
|
||||
{
|
||||
rc = JS_NewArrayObject(cx, 0, NULL);
|
||||
RETVAL = rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_SetElement(cx, obj, idx, valptr)
|
||||
JSContext *cx
|
||||
JSObject *obj
|
||||
int idx
|
||||
char *valptr
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
JSString *str;
|
||||
jsval val;
|
||||
CODE:
|
||||
{
|
||||
str = JS_NewStringCopyZ(cx, valptr);
|
||||
val = STRING_TO_JSVAL(str);
|
||||
rc = JS_SetElement(cx, obj, idx, &val);
|
||||
if(rc) {
|
||||
RETVAL = 1;
|
||||
} else {
|
||||
RETVAL = 0;
|
||||
}
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
int
|
||||
JS_SetElementAsObject(cx, obj, idx, elobj)
|
||||
JSContext *cx
|
||||
JSObject *obj
|
||||
int idx
|
||||
JSObject *elobj
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
jsval val;
|
||||
CODE:
|
||||
{
|
||||
val = OBJECT_TO_JSVAL(elobj);
|
||||
rc = JS_SetElement(cx, obj, idx, &val);
|
||||
if(rc) {
|
||||
RETVAL = 1;
|
||||
} else {
|
||||
RETVAL = 0;
|
||||
}
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
######################################################################
|
||||
void
|
||||
JS_GetElement(cx, obj, idx)
|
||||
JSContext *cx
|
||||
JSObject *obj
|
||||
int idx
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSBool rc;
|
||||
jsval vp;
|
||||
JSString *str;
|
||||
SV *sv = sv_newmortal();
|
||||
PPCODE:
|
||||
{
|
||||
rc = JS_GetElement(cx, obj, idx, &vp);
|
||||
if(rc) {
|
||||
str = JS_ValueToString(cx, vp);
|
||||
if(strcmp(JS_GetStringBytes(str), "undefined") == 0) {
|
||||
sv = &PL_sv_undef;
|
||||
} else {
|
||||
sv_setpv(sv, JS_GetStringBytes(str));
|
||||
}
|
||||
} else {
|
||||
sv = &PL_sv_undef;
|
||||
}
|
||||
XPUSHs(sv);
|
||||
}
|
||||
|
||||
######################################################################
|
||||
JSClass *
|
||||
JS_GetClass(cx, obj)
|
||||
JSContext * cx
|
||||
JSObject * obj
|
||||
######################################################################
|
||||
PREINIT:
|
||||
JSClass *rc;
|
||||
CODE:
|
||||
{
|
||||
#ifdef JS_THREADSAFE
|
||||
rc = JS_GetClass(cx, obj);
|
||||
#else
|
||||
rc = JS_GetClass(obj);
|
||||
#endif
|
||||
RETVAL = rc;
|
||||
}
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
|
||||
######################################################################
|
||||
void
|
||||
JS_SetMaxBranchOperations(cx, max_branch_operations)
|
||||
JSContext *cx
|
||||
int max_branch_operations
|
||||
######################################################################
|
||||
CODE:
|
||||
{
|
||||
PJS_Context* pcx = (PJS_Context *) JS_GetContextPrivate(cx);
|
||||
pcx->branch_count = 0;
|
||||
pcx->branch_max = max_branch_operations;
|
||||
JS_SetBranchCallback(cx, BranchHandler);
|
||||
}
|
||||
OUTPUT:
|
||||
|
||||
|
||||
######################################################################
|
||||
|
||||
|
|
@ -1,810 +0,0 @@
|
|||
10
|
||||
|
||||
dir
|
||||
475
|
||||
svn://erxz.com/bb3/branches/perlbuut/deps/JavaScript-SpiderMonkey-0.19-patched/t
|
||||
svn://erxz.com/bb3
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
dcb1cea6-7f7e-4c78-8a22-148ace8ce36e
|
||||
|
||||
04loop.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
052aecc1ebdaa0ead11238233ae9e5ae
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
543
|
||||
|
||||
001properties.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
74e475b5a99c51f2bb67598cf6697707
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
1837
|
||||
|
||||
000readme.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
289273fc220df68922686441714d5b5b
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
909
|
||||
|
||||
00array.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
02cac23a1988e6ab507d0c6036449959
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
487
|
||||
|
||||
006objmeth.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
e07e8e7be6e6bd4d3bb7dc8fd6976f80
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
1366
|
||||
|
||||
005error.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
e82e5ab0c2ba6981e9054865548c5c6c
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
640
|
||||
|
||||
004setget.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
388f649bb7374f728838a8b20f55caa8
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
2663
|
||||
|
||||
003properties.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
a65e4065a61c6e7f02f7f693760abca8
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
673
|
||||
|
||||
12dblret.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
a7916a2202255276a59f2e3f83ad9af9
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
763
|
||||
|
||||
08func2.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
66a09da3b8f4d7dc3b961cf10eab8bd2
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
487
|
||||
|
||||
13strret.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
59d3cecd83b3570288731abef7ad326a
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
819
|
||||
|
||||
01doc-href.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
e80d98b4a09abbb56324cdc372cf6002
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
487
|
||||
|
||||
02nav-appv.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
30e834fd2efb1165d28bc0f7269b931e
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
469
|
||||
|
||||
002functions.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
31f0487aee924b1494f2b235dbceb5c7
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
1605
|
||||
|
||||
06form2.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
655b103727acf1ab73e382a3f019a1e7
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
739
|
||||
|
||||
10elobj.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
37abbfec8a0e87939014be3fd21048f0
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
634
|
||||
|
||||
007funcret.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
afd19ff93c781c661046451392b9ed67
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
1367
|
||||
|
||||
03doc-write.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
2ef4539e393834a8311b43749cc6660c
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
449
|
||||
|
||||
07func.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
224aff71ecf2cd7afed1756111e69477
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
550
|
||||
|
||||
09meth.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
029ae9fa4c4690ed1983422785eea1b5
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
553
|
||||
|
||||
11intret.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
7f8d43a73df98e3cee3512d714d355df
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
923
|
||||
|
||||
05form.t
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
b7cf61e44e386e0d08e0028153c71847
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
602
|
||||
|
||||
init.pl
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
0197ac936fc64860a3175495240bde1d
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
778
|
||||
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Run the sample code from the README file
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
open FILE, "<SpiderMonkey.pm" or die "Cannot open";
|
||||
my $data = join '', <FILE>;
|
||||
close FILE;
|
||||
|
||||
my $buffer = "";
|
||||
|
||||
# Overwrite print() with our own routine filling $buffer
|
||||
if(my($code) = ($data =~ /SYNOPSIS(.*?)=head1 INSTALL/s)) {
|
||||
$code =~ s/print /myprint/g;
|
||||
eval "sub myprint { \$buffer .= join('', \@_) } $code;
|
||||
\$buffer.=\$rc;
|
||||
\$buffer.=\$url;";
|
||||
}
|
||||
|
||||
if($buffer ne "URL is http://www.aol.com\n1http://www.aol.com") {
|
||||
print "not ('$buffer')";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,63 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Set/Get properties of objects
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
print "1..5\n";
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$js->property_by_path("navigator.appName");
|
||||
$js->property_by_path("navigator.userAgent");
|
||||
$js->property_by_path("navigator.appVersion");
|
||||
$js->property_by_path("document.cookie");
|
||||
$js->property_by_path("parent.location");
|
||||
$js->property_by_path("document.location.href");
|
||||
$js->property_by_path("document.location.yodel");
|
||||
|
||||
# Function to write something from JS to a Perl $buffer
|
||||
my $buffer;
|
||||
my $doc = $js->object_by_path("document");
|
||||
$js->function_set("write", sub { $buffer .= join('', @_) }, $doc);
|
||||
$buffer = "";
|
||||
|
||||
my $code = <<EOT;
|
||||
navigator.appName = "Netscape";
|
||||
navigator.appVersion = "3";
|
||||
navigator.userAgent = "Grugenheimer";
|
||||
document.cookie = "k=v; domain=.netscape.com";
|
||||
parent.location = "http://www.aol.com";
|
||||
document.write(navigator.userAgent);
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
print "not " if $rc != 1;
|
||||
print "ok 1\n";
|
||||
|
||||
# Check simple property
|
||||
print "not " unless $js->property_get("navigator.appName") eq "Netscape";
|
||||
print "ok 2\n";
|
||||
|
||||
# Check simple property
|
||||
print "not " unless $js->property_get("navigator.appVersion") eq "3";
|
||||
print "ok 3\n";
|
||||
|
||||
# Check simple property
|
||||
print "not " unless
|
||||
$js->property_get("document.cookie") eq "k=v; domain=.netscape.com";
|
||||
print "ok 4\n";
|
||||
|
||||
# Check buffer from document.write()
|
||||
print "not " unless $buffer eq "Grugenheimer";
|
||||
print "ok 5\n";
|
||||
|
|
@ -1,60 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Define Functions and Perl callbacks
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
print "1..3\n";
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$js->object_by_path("navigator.appName");
|
||||
$js->object_by_path("document.location");
|
||||
my $parloc = $js->object_by_path("parent.location");
|
||||
$js->function_set("replace",
|
||||
sub { $buffer .= "URL:$_[0]"; }, $parloc);
|
||||
|
||||
# Function write()
|
||||
our $buffer;
|
||||
$js->function_set("write", sub { $buffer .= "f0" . join('', @_) });
|
||||
|
||||
# Method navigator.write()
|
||||
my $doc = $js->object_by_path("document.location");
|
||||
$js->function_set("slice", sub { $buffer .= "f1" . join('', @_) }, $doc);
|
||||
|
||||
# Method navigator.appName.write()
|
||||
$doc = $js->object_by_path("navigator.appName");
|
||||
$js->function_set("dice", sub { $buffer .= "f2" . join('', @_) }, $doc);
|
||||
|
||||
$buffer = "";
|
||||
|
||||
my $code = <<EOT;
|
||||
for(i = 0; i < 2; i++) {
|
||||
write("v1 ");
|
||||
document.location.slice("v2 ");
|
||||
navigator.appName.dice("v3 ");
|
||||
parent.location.replace("testurl");
|
||||
}
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
print "not " if $rc != 1;
|
||||
print "ok 1\n";
|
||||
|
||||
# print $buffer;
|
||||
# Check buffer for traces of function/method calls
|
||||
|
||||
print "not " unless $buffer eq
|
||||
"f0v1 f1v2 f2v3 URL:testurlf0v1 f1v2 f2v3 URL:testurl";
|
||||
print "ok 2\n";
|
||||
|
||||
$js->destroy();
|
||||
|
||||
print "ok 3\n";
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Properties of multi-tiered objects
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
print "1..2\n";
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$js->property_by_path("parent.location.href", "abc");
|
||||
my $res = $js->property_get("parent.location.href");
|
||||
|
||||
# Check return code
|
||||
print "not " if $res ne "abc";
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
||||
print "ok 2\n";
|
||||
|
|
@ -1,119 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Set/Get properties of objects
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
print "1..6\n";
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
our $buffer = "";
|
||||
|
||||
sub getter {
|
||||
my(@args) = @_;
|
||||
$buffer .= "GETTER: @args\n";
|
||||
}
|
||||
|
||||
sub setter {
|
||||
my(@args) = @_;
|
||||
$buffer .= "SETTER: @args\n";
|
||||
}
|
||||
|
||||
$js->property_by_path("navigator.appName", "", \&getter, \&setter);
|
||||
|
||||
# Function to write something from JS to a Perl $buffer
|
||||
|
||||
my $code = <<EOT;
|
||||
navigator.appName = "Netscape";
|
||||
navigator.schnapp = navigator.appName;
|
||||
navigator.appName = "Netscape2";
|
||||
navigator.schnapp = navigator.appName;
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
print "not " if $rc != 1;
|
||||
print "ok 1\n";
|
||||
|
||||
# Check output
|
||||
my $wanted = "SETTER: navigator.appName Netscape\n" .
|
||||
"GETTER: navigator.appName Netscape\n" .
|
||||
"SETTER: navigator.appName Netscape2\n" .
|
||||
"GETTER: navigator.appName Netscape2\n";
|
||||
if($buffer ne $wanted) {
|
||||
print "not ok 2\n";
|
||||
print "Expected $wanted but got '$buffer'\n";
|
||||
} else {
|
||||
print "ok 2\n";
|
||||
}
|
||||
|
||||
$js->destroy();
|
||||
|
||||
##################################################
|
||||
# Setter only, no getter
|
||||
##################################################
|
||||
$js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$buffer = "";
|
||||
|
||||
$js->property_by_path("navigator.appName", "", undef, \&setter);
|
||||
|
||||
$rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
print "not " if $rc != 1;
|
||||
print "ok 3\n";
|
||||
|
||||
# Check output
|
||||
$wanted = "SETTER: navigator.appName Netscape\n" .
|
||||
"SETTER: navigator.appName Netscape2\n";
|
||||
|
||||
if($buffer ne $wanted) {
|
||||
print "not ok 4\n";
|
||||
print "Expected $wanted but got '$buffer'\n";
|
||||
} else {
|
||||
print "ok 4\n";
|
||||
}
|
||||
|
||||
$js->destroy();
|
||||
|
||||
##################################################
|
||||
# Getter only, no setter
|
||||
##################################################
|
||||
$js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$buffer = "";
|
||||
|
||||
$js->property_by_path("navigator.appName", "", \&getter);
|
||||
|
||||
$rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
print "not " if $rc != 1;
|
||||
print "ok 5\n";
|
||||
|
||||
# Check output
|
||||
$wanted = "GETTER: navigator.appName Netscape\n" .
|
||||
"GETTER: navigator.appName Netscape2\n";
|
||||
|
||||
if($buffer ne $wanted) {
|
||||
print "not ok 6\n";
|
||||
print "Expected $wanted but got '$buffer'\n";
|
||||
} else {
|
||||
print "ok 6\n";
|
||||
}
|
||||
|
||||
$js->destroy();
|
||||
|
||||
|
|
@ -1,30 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Produce an error and check $@
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2004
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
my $code = <<EOT;
|
||||
foo = "bar;
|
||||
EOT
|
||||
|
||||
$js->eval($code);
|
||||
|
||||
if($@ =~ /unterminated string literal/) {
|
||||
print "ok 1\n";
|
||||
} else {
|
||||
print "not ok 1\n";
|
||||
}
|
||||
|
|
@ -1,44 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Functions/Methods for different objects
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2004
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Test::More qw(no_plan);
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$js->property_by_path("document.location.href");
|
||||
$js->property_by_path("document.location.yodel");
|
||||
$js->property_by_path("document.someobj.someprop");
|
||||
|
||||
# Function to write something from JS to a Perl $buffer
|
||||
my $location_buffer;
|
||||
my $doc = $js->object_by_path("document.location");
|
||||
$js->function_set("write", sub { $location_buffer .= join('', @_) }, $doc);
|
||||
|
||||
my $someobj_buffer;
|
||||
my $someobj = $js->object_by_path("document.someobj");
|
||||
$js->function_set("write", sub { $someobj_buffer .= join('', @_) }, $someobj);
|
||||
|
||||
my $code = <<EOT;
|
||||
document.location.write("location message");
|
||||
document.someobj.write("someobj message");
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
ok($rc, "JS return code");
|
||||
|
||||
# Check location buffer
|
||||
is($location_buffer, "location message", "check loc buffer");
|
||||
is($someobj_buffer, "someobj message", "check someobj buffer");
|
||||
|
|
@ -1,47 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Returning values from perl callbacks
|
||||
# Revision: $Revision: 1.2 $
|
||||
# Last Checkin: $Date: 2006/06/13 13:42:58 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2004
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Test::More qw(no_plan);
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
use Log::Log4perl qw(:easy);
|
||||
Log::Log4perl->easy_init($ERROR);
|
||||
|
||||
my $buffer = "";
|
||||
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
# Example by Chris Blaise:
|
||||
# Let new function document.getElementById('id') (defined in Perl space)
|
||||
# return an object into JS.
|
||||
|
||||
my $doc = $js->object_by_path('document' );
|
||||
$js->property_by_path('fooobj.style' );
|
||||
$js->function_set( 'getElementById', sub {
|
||||
if(exists $JavaScript::SpiderMonkey::GLOBAL->{objects}->{'fooobj'}) {
|
||||
return $JavaScript::SpiderMonkey::GLOBAL->{objects}->{'fooobj'};
|
||||
}
|
||||
}, $doc);
|
||||
$js->function_set("write", sub {
|
||||
$buffer .= join('', map { "[$_]" } @_) }, $doc);
|
||||
|
||||
my $code = q{
|
||||
document.getElementById('bleh').style = 'something';
|
||||
document.write(fooobj.style);
|
||||
};
|
||||
|
||||
my $rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
ok($rc, "Function returning object");
|
||||
is($buffer, "[something]", "Attribute assigned correctly");
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
######################################################################
|
||||
# Create an array as part of an object
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
$js->array_by_path("document.form");
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.form[0] = "abc";
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
if($js->property_get("navigator.appVersion") ne "3") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,24 +0,0 @@
|
|||
######################################################################
|
||||
# Set and retrieve document.location.href
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.location.href = "http://www.com";
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
if($js->property_get("document.location.href") ne "http://www.com") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
######################################################################
|
||||
# Set and retrieve document.location.href
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.location.href = "http://www.com";
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
if($js->property_get("navigator.appVersion") ne "3") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
######################################################################
|
||||
# Set and retrieve document.location.href
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.write("abc");
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
if($js->property_get("navigator.appVersion") ne "3") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
######################################################################
|
||||
# docwrite()
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.write("abc");
|
||||
EOT
|
||||
my $oks = 0;
|
||||
my $nof = 100;
|
||||
|
||||
for my $i (1..$nof) {
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
if($js->property_get("navigator.appVersion") eq "3") {
|
||||
$oks++;
|
||||
}
|
||||
}
|
||||
|
||||
if($nof != $oks) {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
######################################################################
|
||||
# docwrite()
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
function FormSubmit () {
|
||||
document.location.href = "submitted!";
|
||||
}
|
||||
function Form() {
|
||||
this.submit = FormSubmit;
|
||||
}
|
||||
|
||||
document.form[0] = new Form;
|
||||
document.form[0].submit();
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
if($js->property_get("document.location.href") ne "submitted!") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
######################################################################
|
||||
# docwrite()
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $a = $js->array_by_path("document.array");
|
||||
my $e = $js->array_set_element($a, 0, "gurkenhobel");
|
||||
#print "SetElement returned $e\n";
|
||||
my $r = $js->array_get_element($a, 0);
|
||||
#print "r=$r\n";
|
||||
#print $js->dump();
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.location.href = document.array[0];
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
my $val = $js->property_get("document.location.href");
|
||||
|
||||
if($val ne "gurkenhobel") {
|
||||
print STDERR "Val is '$val'\n";
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
######################################################################
|
||||
# functions
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
$buffer = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.write("abc", "def");
|
||||
document.write("abc2", "def2");
|
||||
document.write("abc3", "def3");
|
||||
document.write("abc4", "def4");
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
if($buffer ne "abcdefabc2def2abc3def3abc4def4") {
|
||||
print "not ";
|
||||
}
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
######################################################################
|
||||
# functions2
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
$args = "";
|
||||
|
||||
$js->function_set("farz", sub { $args = join '', @_ });
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
farz("abc", "def", 3, 5, 8);
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
if($args ne "abcdef358") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,30 +0,0 @@
|
|||
######################################################################
|
||||
# functions2
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
$args = "";
|
||||
|
||||
my $docobj = $js->object_by_path("document");
|
||||
$js->function_set("schnubbel", sub { $args = join '', @_; });
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.schnubbel("abc", "def", 3, 5, 8);
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
if($args ne "abcdef358") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
######################################################################
|
||||
# functions2
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
$submitted = "0";
|
||||
|
||||
my $obj = $js->object_by_path("submitter");
|
||||
$js->function_set("submit", sub { $submitted = 1 });
|
||||
|
||||
my $forms = $js->array_by_path("document.forms");
|
||||
my $e = $js->array_set_element_as_object($forms, 0, $obj);
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.forms[0].submit();
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
if(!$submitted) {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Returning integer values from perl
|
||||
# Revision: $Revision: 1.1 $
|
||||
# Last Checkin: $Date: 2006/06/13 13:43:51 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Author: Marc Relation marc@igneousconsulting.com
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $js=new JavaScript::SpiderMonkey;
|
||||
my $buffer;
|
||||
$js->init;
|
||||
$js->function_set('get_int',sub {return(1000);});
|
||||
$js->function_set('get_float',sub {return(10.21);});
|
||||
$js->function_set('booltest',sub {return 1==$_[0];});
|
||||
#$js->function_set('write',sub {print STDERR $_[0] . "\n"});
|
||||
$js->function_set("write",sub { $buffer .= join('', @_) });
|
||||
$js->eval("write(get_int()+1);");
|
||||
$js->destroy;
|
||||
# Check buffer from document.write()
|
||||
print "not " unless $buffer == 1001;
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Returning double values from perl
|
||||
# Revision: $Revision: 1.1 $
|
||||
# Last Checkin: $Date: 2006/06/13 13:43:51 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Author: Marc Relation marc@igneousconsulting.com
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
print "1..1\n";
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $js=new JavaScript::SpiderMonkey;
|
||||
my $buffer;
|
||||
$js->init;
|
||||
$js->function_set('get_double',sub {return(10.21);});
|
||||
$js->function_set("write",sub { $buffer .= join('', @_) });
|
||||
$js->eval("write(get_double()+1.2);");
|
||||
$js->destroy;
|
||||
# Check buffer from document.write()
|
||||
print "not " unless $buffer == 11.41;
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Returning string values from perl
|
||||
# Revision: $Revision: 1.1 $
|
||||
# Last Checkin: $Date: 2006/06/13 13:43:51 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Author: Marc Relation marc@igneousconsulting.com
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
use Test::More tests => 1;
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $js = new JavaScript::SpiderMonkey;
|
||||
my $buffer;
|
||||
$js->init;
|
||||
$js->function_set('get_string',sub { return "John Doe";});
|
||||
#$js->function_set('write',sub {print STDERR $_[0] . "\n"});
|
||||
$js->function_set("write",sub { $buffer .= join('', @_) });
|
||||
$js->eval("write(get_string()+' who');");
|
||||
$js->destroy;
|
||||
# Check buffer from document.write()
|
||||
is $buffer, 'John Doe who';
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $docloc = "http://wurks";
|
||||
$js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$js->property_by_path("navigator.appName");
|
||||
$js->property_by_path("navigator.userAgent");
|
||||
$js->property_by_path("navigator.appVersion");
|
||||
$js->property_by_path("document.cookie");
|
||||
$js->property_by_path("parent.location");
|
||||
$js->property_by_path("document.location.href");
|
||||
|
||||
my $doc = $js->object_by_path("document");
|
||||
$js->function_set("write", sub { $buffer .= join('', @_) }, $doc);
|
||||
$buffer = "";
|
||||
|
||||
$init = <<EOT;
|
||||
navigator.appName = "Netscape";
|
||||
navigator.appVersion = "3";
|
||||
navigator.userAgent = "Grugenheimer";
|
||||
document.cookie = "";
|
||||
parent.location = "";
|
||||
document.location.href = "$docloc";
|
||||
document.form = new Array(100);
|
||||
EOT
|
||||
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Run the sample code from the README file
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
open FILE, "<SpiderMonkey.pm" or die "Cannot open";
|
||||
my $data = join '', <FILE>;
|
||||
close FILE;
|
||||
|
||||
my $buffer = "";
|
||||
|
||||
# Overwrite print() with our own routine filling $buffer
|
||||
if(my($code) = ($data =~ /SYNOPSIS(.*?)=head1 INSTALL/s)) {
|
||||
$code =~ s/print /myprint/g;
|
||||
eval "sub myprint { \$buffer .= join('', \@_) } $code;
|
||||
\$buffer.=\$rc;
|
||||
\$buffer.=\$url;";
|
||||
}
|
||||
|
||||
if($buffer ne "URL is http://www.aol.com\n1http://www.aol.com") {
|
||||
print "not ('$buffer')";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,63 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Set/Get properties of objects
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
print "1..5\n";
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$js->property_by_path("navigator.appName");
|
||||
$js->property_by_path("navigator.userAgent");
|
||||
$js->property_by_path("navigator.appVersion");
|
||||
$js->property_by_path("document.cookie");
|
||||
$js->property_by_path("parent.location");
|
||||
$js->property_by_path("document.location.href");
|
||||
$js->property_by_path("document.location.yodel");
|
||||
|
||||
# Function to write something from JS to a Perl $buffer
|
||||
my $buffer;
|
||||
my $doc = $js->object_by_path("document");
|
||||
$js->function_set("write", sub { $buffer .= join('', @_) }, $doc);
|
||||
$buffer = "";
|
||||
|
||||
my $code = <<EOT;
|
||||
navigator.appName = "Netscape";
|
||||
navigator.appVersion = "3";
|
||||
navigator.userAgent = "Grugenheimer";
|
||||
document.cookie = "k=v; domain=.netscape.com";
|
||||
parent.location = "http://www.aol.com";
|
||||
document.write(navigator.userAgent);
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
print "not " if $rc != 1;
|
||||
print "ok 1\n";
|
||||
|
||||
# Check simple property
|
||||
print "not " unless $js->property_get("navigator.appName") eq "Netscape";
|
||||
print "ok 2\n";
|
||||
|
||||
# Check simple property
|
||||
print "not " unless $js->property_get("navigator.appVersion") eq "3";
|
||||
print "ok 3\n";
|
||||
|
||||
# Check simple property
|
||||
print "not " unless
|
||||
$js->property_get("document.cookie") eq "k=v; domain=.netscape.com";
|
||||
print "ok 4\n";
|
||||
|
||||
# Check buffer from document.write()
|
||||
print "not " unless $buffer eq "Grugenheimer";
|
||||
print "ok 5\n";
|
||||
|
|
@ -1,60 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Define Functions and Perl callbacks
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
print "1..3\n";
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$js->object_by_path("navigator.appName");
|
||||
$js->object_by_path("document.location");
|
||||
my $parloc = $js->object_by_path("parent.location");
|
||||
$js->function_set("replace",
|
||||
sub { $buffer .= "URL:$_[0]"; }, $parloc);
|
||||
|
||||
# Function write()
|
||||
our $buffer;
|
||||
$js->function_set("write", sub { $buffer .= "f0" . join('', @_) });
|
||||
|
||||
# Method navigator.write()
|
||||
my $doc = $js->object_by_path("document.location");
|
||||
$js->function_set("slice", sub { $buffer .= "f1" . join('', @_) }, $doc);
|
||||
|
||||
# Method navigator.appName.write()
|
||||
$doc = $js->object_by_path("navigator.appName");
|
||||
$js->function_set("dice", sub { $buffer .= "f2" . join('', @_) }, $doc);
|
||||
|
||||
$buffer = "";
|
||||
|
||||
my $code = <<EOT;
|
||||
for(i = 0; i < 2; i++) {
|
||||
write("v1 ");
|
||||
document.location.slice("v2 ");
|
||||
navigator.appName.dice("v3 ");
|
||||
parent.location.replace("testurl");
|
||||
}
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
print "not " if $rc != 1;
|
||||
print "ok 1\n";
|
||||
|
||||
# print $buffer;
|
||||
# Check buffer for traces of function/method calls
|
||||
|
||||
print "not " unless $buffer eq
|
||||
"f0v1 f1v2 f2v3 URL:testurlf0v1 f1v2 f2v3 URL:testurl";
|
||||
print "ok 2\n";
|
||||
|
||||
$js->destroy();
|
||||
|
||||
print "ok 3\n";
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Properties of multi-tiered objects
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
print "1..2\n";
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$js->property_by_path("parent.location.href", "abc");
|
||||
my $res = $js->property_get("parent.location.href");
|
||||
|
||||
# Check return code
|
||||
print "not " if $res ne "abc";
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
||||
print "ok 2\n";
|
||||
|
|
@ -1,119 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Set/Get properties of objects
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2002
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
print "1..6\n";
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
our $buffer = "";
|
||||
|
||||
sub getter {
|
||||
my(@args) = @_;
|
||||
$buffer .= "GETTER: @args\n";
|
||||
}
|
||||
|
||||
sub setter {
|
||||
my(@args) = @_;
|
||||
$buffer .= "SETTER: @args\n";
|
||||
}
|
||||
|
||||
$js->property_by_path("navigator.appName", "", \&getter, \&setter);
|
||||
|
||||
# Function to write something from JS to a Perl $buffer
|
||||
|
||||
my $code = <<EOT;
|
||||
navigator.appName = "Netscape";
|
||||
navigator.schnapp = navigator.appName;
|
||||
navigator.appName = "Netscape2";
|
||||
navigator.schnapp = navigator.appName;
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
print "not " if $rc != 1;
|
||||
print "ok 1\n";
|
||||
|
||||
# Check output
|
||||
my $wanted = "SETTER: navigator.appName Netscape\n" .
|
||||
"GETTER: navigator.appName Netscape\n" .
|
||||
"SETTER: navigator.appName Netscape2\n" .
|
||||
"GETTER: navigator.appName Netscape2\n";
|
||||
if($buffer ne $wanted) {
|
||||
print "not ok 2\n";
|
||||
print "Expected $wanted but got '$buffer'\n";
|
||||
} else {
|
||||
print "ok 2\n";
|
||||
}
|
||||
|
||||
$js->destroy();
|
||||
|
||||
##################################################
|
||||
# Setter only, no getter
|
||||
##################################################
|
||||
$js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$buffer = "";
|
||||
|
||||
$js->property_by_path("navigator.appName", "", undef, \&setter);
|
||||
|
||||
$rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
print "not " if $rc != 1;
|
||||
print "ok 3\n";
|
||||
|
||||
# Check output
|
||||
$wanted = "SETTER: navigator.appName Netscape\n" .
|
||||
"SETTER: navigator.appName Netscape2\n";
|
||||
|
||||
if($buffer ne $wanted) {
|
||||
print "not ok 4\n";
|
||||
print "Expected $wanted but got '$buffer'\n";
|
||||
} else {
|
||||
print "ok 4\n";
|
||||
}
|
||||
|
||||
$js->destroy();
|
||||
|
||||
##################################################
|
||||
# Getter only, no setter
|
||||
##################################################
|
||||
$js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$buffer = "";
|
||||
|
||||
$js->property_by_path("navigator.appName", "", \&getter);
|
||||
|
||||
$rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
print "not " if $rc != 1;
|
||||
print "ok 5\n";
|
||||
|
||||
# Check output
|
||||
$wanted = "GETTER: navigator.appName Netscape\n" .
|
||||
"GETTER: navigator.appName Netscape2\n";
|
||||
|
||||
if($buffer ne $wanted) {
|
||||
print "not ok 6\n";
|
||||
print "Expected $wanted but got '$buffer'\n";
|
||||
} else {
|
||||
print "ok 6\n";
|
||||
}
|
||||
|
||||
$js->destroy();
|
||||
|
||||
|
|
@ -1,30 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Produce an error and check $@
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2004
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
my $code = <<EOT;
|
||||
foo = "bar;
|
||||
EOT
|
||||
|
||||
$js->eval($code);
|
||||
|
||||
if($@ =~ /unterminated string literal/) {
|
||||
print "ok 1\n";
|
||||
} else {
|
||||
print "not ok 1\n";
|
||||
}
|
||||
|
|
@ -1,44 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Functions/Methods for different objects
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2004
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Test::More qw(no_plan);
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$js->property_by_path("document.location.href");
|
||||
$js->property_by_path("document.location.yodel");
|
||||
$js->property_by_path("document.someobj.someprop");
|
||||
|
||||
# Function to write something from JS to a Perl $buffer
|
||||
my $location_buffer;
|
||||
my $doc = $js->object_by_path("document.location");
|
||||
$js->function_set("write", sub { $location_buffer .= join('', @_) }, $doc);
|
||||
|
||||
my $someobj_buffer;
|
||||
my $someobj = $js->object_by_path("document.someobj");
|
||||
$js->function_set("write", sub { $someobj_buffer .= join('', @_) }, $someobj);
|
||||
|
||||
my $code = <<EOT;
|
||||
document.location.write("location message");
|
||||
document.someobj.write("someobj message");
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
ok($rc, "JS return code");
|
||||
|
||||
# Check location buffer
|
||||
is($location_buffer, "location message", "check loc buffer");
|
||||
is($someobj_buffer, "someobj message", "check someobj buffer");
|
||||
|
|
@ -1,47 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Returning values from perl callbacks
|
||||
# Revision: $Revision: 1.2 $
|
||||
# Last Checkin: $Date: 2006/06/13 13:42:58 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Author: Mike Schilli m@perlmeister.com, 2004
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
use Test::More qw(no_plan);
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
use Log::Log4perl qw(:easy);
|
||||
Log::Log4perl->easy_init($ERROR);
|
||||
|
||||
my $buffer = "";
|
||||
|
||||
my $js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
# Example by Chris Blaise:
|
||||
# Let new function document.getElementById('id') (defined in Perl space)
|
||||
# return an object into JS.
|
||||
|
||||
my $doc = $js->object_by_path('document' );
|
||||
$js->property_by_path('fooobj.style' );
|
||||
$js->function_set( 'getElementById', sub {
|
||||
if(exists $JavaScript::SpiderMonkey::GLOBAL->{objects}->{'fooobj'}) {
|
||||
return $JavaScript::SpiderMonkey::GLOBAL->{objects}->{'fooobj'};
|
||||
}
|
||||
}, $doc);
|
||||
$js->function_set("write", sub {
|
||||
$buffer .= join('', map { "[$_]" } @_) }, $doc);
|
||||
|
||||
my $code = q{
|
||||
document.getElementById('bleh').style = 'something';
|
||||
document.write(fooobj.style);
|
||||
};
|
||||
|
||||
my $rc = $js->eval($code);
|
||||
|
||||
# Check return code
|
||||
ok($rc, "Function returning object");
|
||||
is($buffer, "[something]", "Attribute assigned correctly");
|
||||
|
|
@ -1,23 +0,0 @@
|
|||
######################################################################
|
||||
# Create an array as part of an object
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
$js->array_by_path("document.form");
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.form[0] = "abc";
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
if($js->property_get("navigator.appVersion") ne "3") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,24 +0,0 @@
|
|||
######################################################################
|
||||
# Set and retrieve document.location.href
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.location.href = "http://www.com";
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
if($js->property_get("document.location.href") ne "http://www.com") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
######################################################################
|
||||
# Set and retrieve document.location.href
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.location.href = "http://www.com";
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
if($js->property_get("navigator.appVersion") ne "3") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
######################################################################
|
||||
# Set and retrieve document.location.href
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.write("abc");
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
if($js->property_get("navigator.appVersion") ne "3") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
######################################################################
|
||||
# docwrite()
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.write("abc");
|
||||
EOT
|
||||
my $oks = 0;
|
||||
my $nof = 100;
|
||||
|
||||
for my $i (1..$nof) {
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
if($js->property_get("navigator.appVersion") eq "3") {
|
||||
$oks++;
|
||||
}
|
||||
}
|
||||
|
||||
if($nof != $oks) {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
######################################################################
|
||||
# docwrite()
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
function FormSubmit () {
|
||||
document.location.href = "submitted!";
|
||||
}
|
||||
function Form() {
|
||||
this.submit = FormSubmit;
|
||||
}
|
||||
|
||||
document.form[0] = new Form;
|
||||
document.form[0].submit();
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
if($js->property_get("document.location.href") ne "submitted!") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
######################################################################
|
||||
# docwrite()
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $a = $js->array_by_path("document.array");
|
||||
my $e = $js->array_set_element($a, 0, "gurkenhobel");
|
||||
#print "SetElement returned $e\n";
|
||||
my $r = $js->array_get_element($a, 0);
|
||||
#print "r=$r\n";
|
||||
#print $js->dump();
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.location.href = document.array[0];
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
my $val = $js->property_get("document.location.href");
|
||||
|
||||
if($val ne "gurkenhobel") {
|
||||
print STDERR "Val is '$val'\n";
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
######################################################################
|
||||
# functions
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
$buffer = "";
|
||||
require "t/init.pl";
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.write("abc", "def");
|
||||
document.write("abc2", "def2");
|
||||
document.write("abc3", "def3");
|
||||
document.write("abc4", "def4");
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
if($buffer ne "abcdefabc2def2abc3def3abc4def4") {
|
||||
print "not ";
|
||||
}
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
######################################################################
|
||||
# functions2
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
$args = "";
|
||||
|
||||
$js->function_set("farz", sub { $args = join '', @_ });
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
farz("abc", "def", 3, 5, 8);
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
if($args ne "abcdef358") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,30 +0,0 @@
|
|||
######################################################################
|
||||
# functions2
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
$args = "";
|
||||
|
||||
my $docobj = $js->object_by_path("document");
|
||||
$js->function_set("schnubbel", sub { $args = join '', @_; });
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.schnubbel("abc", "def", 3, 5, 8);
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
if($args ne "abcdef358") {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,33 +0,0 @@
|
|||
######################################################################
|
||||
# functions2
|
||||
######################################################################
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
$init = "";
|
||||
require "t/init.pl";
|
||||
|
||||
$submitted = "0";
|
||||
|
||||
my $obj = $js->object_by_path("submitter");
|
||||
$js->function_set("submit", sub { $submitted = 1 });
|
||||
|
||||
my $forms = $js->array_by_path("document.forms");
|
||||
my $e = $js->array_set_element_as_object($forms, 0, $obj);
|
||||
|
||||
my $source = <<EOT;
|
||||
$init
|
||||
document.forms[0].submit();
|
||||
EOT
|
||||
|
||||
my $rc = $js->eval($source);
|
||||
|
||||
die "eval returned undef" unless $rc;
|
||||
|
||||
if(!$submitted) {
|
||||
print "not ";
|
||||
}
|
||||
|
||||
print "ok 1\n";
|
||||
|
||||
$js->destroy();
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Returning integer values from perl
|
||||
# Revision: $Revision: 1.1 $
|
||||
# Last Checkin: $Date: 2006/06/13 13:43:51 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Author: Marc Relation marc@igneousconsulting.com
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
print "1..1\n";
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $js=new JavaScript::SpiderMonkey;
|
||||
my $buffer;
|
||||
$js->init;
|
||||
$js->function_set('get_int',sub {return(1000);});
|
||||
$js->function_set('get_float',sub {return(10.21);});
|
||||
$js->function_set('booltest',sub {return 1==$_[0];});
|
||||
#$js->function_set('write',sub {print STDERR $_[0] . "\n"});
|
||||
$js->function_set("write",sub { $buffer .= join('', @_) });
|
||||
$js->eval("write(get_int()+1);");
|
||||
$js->destroy;
|
||||
# Check buffer from document.write()
|
||||
print "not " unless $buffer == 1001;
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Returning double values from perl
|
||||
# Revision: $Revision: 1.1 $
|
||||
# Last Checkin: $Date: 2006/06/13 13:43:51 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Author: Marc Relation marc@igneousconsulting.com
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
print "1..1\n";
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $js=new JavaScript::SpiderMonkey;
|
||||
my $buffer;
|
||||
$js->init;
|
||||
$js->function_set('get_double',sub {return(10.21);});
|
||||
$js->function_set("write",sub { $buffer .= join('', @_) });
|
||||
$js->eval("write(get_double()+1.2);");
|
||||
$js->destroy;
|
||||
# Check buffer from document.write()
|
||||
print "not " unless $buffer == 11.41;
|
||||
print "ok 1\n";
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
######################################################################
|
||||
# Testcase: Returning string values from perl
|
||||
# Revision: $Revision: 1.1 $
|
||||
# Last Checkin: $Date: 2006/06/13 13:43:51 $
|
||||
# By: $Author: thomas_busch $
|
||||
#
|
||||
# Author: Marc Relation marc@igneousconsulting.com
|
||||
######################################################################
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
use Test::More tests => 1;
|
||||
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $js = new JavaScript::SpiderMonkey;
|
||||
my $buffer;
|
||||
$js->init;
|
||||
$js->function_set('get_string',sub { return "John Doe";});
|
||||
#$js->function_set('write',sub {print STDERR $_[0] . "\n"});
|
||||
$js->function_set("write",sub { $buffer .= join('', @_) });
|
||||
$js->eval("write(get_string()+' who');");
|
||||
$js->destroy;
|
||||
# Check buffer from document.write()
|
||||
is $buffer, 'John Doe who';
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
|
||||
use JavaScript::SpiderMonkey;
|
||||
|
||||
my $docloc = "http://wurks";
|
||||
$js = JavaScript::SpiderMonkey->new();
|
||||
$js->init();
|
||||
|
||||
$js->property_by_path("navigator.appName");
|
||||
$js->property_by_path("navigator.userAgent");
|
||||
$js->property_by_path("navigator.appVersion");
|
||||
$js->property_by_path("document.cookie");
|
||||
$js->property_by_path("parent.location");
|
||||
$js->property_by_path("document.location.href");
|
||||
|
||||
my $doc = $js->object_by_path("document");
|
||||
$js->function_set("write", sub { $buffer .= join('', @_) }, $doc);
|
||||
$buffer = "";
|
||||
|
||||
$init = <<EOT;
|
||||
navigator.appName = "Netscape";
|
||||
navigator.appVersion = "3";
|
||||
navigator.userAgent = "Grugenheimer";
|
||||
document.cookie = "";
|
||||
parent.location = "";
|
||||
document.location.href = "$docloc";
|
||||
document.form = new Array(100);
|
||||
EOT
|
||||
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
######################################################################
|
||||
# Typemap for JavaScript::SpiderMonkey
|
||||
#
|
||||
# Revision: $Revision: 1.1.1.1 $
|
||||
# Last Checkin: $Date: 2006/02/01 06:00:49 $
|
||||
# By: $Author: mschilli $
|
||||
# Author: Mike Schilli mschilli1@aol.com, 2002
|
||||
######################################################################
|
||||
JSRuntime * T_PTRREF
|
||||
JSContext * T_PTRREF
|
||||
JSClass * T_PTRREF
|
||||
JSObject * T_PTRREF
|
||||
JSNative T_PTRREF
|
||||
JSPropertySpec * T_PTRREF
|
||||
JSFunctionSpec * T_PTRREF
|
||||
uintN T_SV
|
||||
JSBool T_SV
|
||||
|
|
@ -1,62 +0,0 @@
|
|||
10
|
||||
|
||||
dir
|
||||
475
|
||||
svn://erxz.com/bb3/branches/perlbuut/deps/JavaScript-SpiderMonkey-0.19-patched/util
|
||||
svn://erxz.com/bb3
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
dcb1cea6-7f7e-4c78-8a22-148ace8ce36e
|
||||
|
||||
download.pl
|
||||
file
|
||||
|
||||
|
||||
|
||||
|
||||
2009-10-03T22:54:20.000000Z
|
||||
b5c784121a686894bb029b3cacdb1eae
|
||||
2009-10-03T22:53:42.528878Z
|
||||
475
|
||||
simcop
|
||||
has-props
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
861
|
||||
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
K 14
|
||||
svn:executable
|
||||
V 1
|
||||
*
|
||||
END
|
||||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Reference in a new issue