JavaScript::Context - An object in which we can execute JavaScript

JavaScript documentation Contained in the JavaScript distribution.

Index

Code Index:

NAME

Top

JavaScript::Context - An object in which we can execute JavaScript

SYNOPSIS

Top

  use JavaScript;

  # Create a runtime and a context
  my $rt = JavaScript::Runtime->new();
  my $cx = $rt->create_context();

  # Add a function which we can call from JavaScript
  $cx->bind_function(print => sub { print @_; });

  my $result = $cx->eval($source);

INTERFACE

Top

INSTANCE METHODS

bind_class ( %args )

Defines a new class that can be used from JavaScript in the contet.

It expects the following arguments

name

The name of the class in JavaScript.

  name => "MyPackage",
constructor

A reference to a subroutine that returns the Perl object that represents the JavaScript object. If omitted a default constructor will be supplied that calls the method new on the defined package (or name if no package is defined).

  constructor => sub { MyPackage->new(@_); },
package

The name of the Perl package that represents this class. It will be passed as first argument to any class methods and also used in the default constructor.

  package => "My::Package",
methods (fs)

A hash reference of methods that we define for instances of the class. In JavaScript this would be o = new MyClass(); o.method().

The key is used as the name of the function and the value should be either a reference to a subroutine or the name of the Perl subroutine to call.

  methods => { to_string => \&My::Package::to_string,
               random    => "randomize"
  }
static_methods (static_ps)

Like fs but these are called on the class itself. In JavaScript this would be MyClass.method().

properties (ps)

A hash reference of properties that we define for instances of the class. In JavaScript this would be o = new MyClass(); f = o.property;

The key is used as the name of the property and the value is used to specify what method to call as a get-operation and as a set-operation. These can either be specified using references to subroutines or name of subroutines. If the getter is undefined the property will be write-only and if the setter is undefined the property will be read-only. You can specify the getter/setter using either an array reference, [\&MyClass::get_property, \&MyClass::set_property], a string, "MyClass::set_property MyClass::get_property" or a hash reference, { getter = "MyClass::get_property", setter => "MyClass::set_property" }>.

  ps => { length => [qw(get_length)],
          parent => { getter => \&MyClass::get_parent, setter => \&MyClass::set_parent },
        }
static_properties (static_ps)

Like ps but these are defined on the class itself. In JavaScript this would be f = MyClass.property.

flags

A bitmask of attributes for the class. Valid attributes are:

JS_CLASS_NO_INSTANCE

Makes the class throw an exception if JavaScript tries to instansiate the class.

bind_function ( name => $name, func => $subroutine )
bind_function ( $name => $subroutine )

Defines a Perl subroutine ($subroutine_ref) as a native function with the given $name. The argument $subroutine can either be the name of a subroutine or a reference to one.

bind_object ( $name => $object )

Binds a Perl object to the context under a given name.

bind_value ( $name => $value )

Defines a value with a given name and value. Trying to redefine an already existing property throws an exception.

unbind_value ( $name )

Removed a property from the context or a specified object.

call ( $name, @arguments )
call ( $function, @arguments )

Calls a function with the given name $name or the JavaScript::Function-object $function and passes the rest of the arguments to the JavaScript function.

can ( $name )

Returns true if there is a function with a given $name, otherwise it returns false.

compile ( $source )

Pre-compiles the JavaScript given in $source and returns a JavaScript::Script-object that can be executed over and over again. If an error occures because of a compilation error it returns undef and $@ is set.

eval ( $source )

Evaluates the JavaScript code given in $source and returns the result from the last statement.

If there is a compilation error (such as a syntax error) or an uncaught exception is thrown in JavaScript this method returns undef and $@ is set.

eval_file ( $path )

Evaluates the JavaScript code in the file specified by $path and returns the result from the last statement.

If there is a compilation error (such as a syntax error) or an uncaught exception is thrown in JavaScript this method returns undef and $@ is set.

find ( $native_context )

Returns the JavaScript::Context-object associated with a given native context.

set_branch_handler ( $handler )

Attaches an branch callback handler (a function that is called when a branch is performed) to the context. The argument $handler may be a code-reference or the name of a subroutine.

To remove the handler call this method with an undefined argument.

The handler is called when a script branches backwards during execution, when a function returns and the end of the script. To continue execution the handler must return a true value. To abort execution either throw an exception or return a false value.

set_pending_exception ( $value )

Converts the $value to JavaScript and sets it as the pending exception for the context.

get_version ( )

Returns the runtime version of the context as a string, for exmaple 1.7 or or ECMAv3.

set_version ( $version )

Sets the runtime version of the context to that specified in the string $version. Some features such as let and yield might not be enabled by default and thus must be turned on by specifying what JS version we're using.

A list of these can be found at http://developer.mozilla.org/en/docs/JSVersion but may vary depending on the version of your runtime.

get_options ( )

Returns a list of the options currently enabled on the context.

has_options ( OPTION, ... )

Tests if the options are eneabled on the context.

toggle_options ( OPTION, ... )

Toggles the options on the context.

OPTIONS

A number of options can be set on contexts. The following are understood (case-insensitive):

strict

Warn on dubious practice.

xml

ECMAScript for XML (E4X) support: parse <!-- --> as a token, not backward compatible with the comment-hiding hack used in HTML script tags.

jit

Enable JIT compilation. Requires a SpiderMonkey with TraceMonkey.

(Descriptions copied from jsapi.h and thus copyrighted under its license)

JavaScript documentation Contained in the JavaScript distribution. 
package JavaScript::Context;

use strict;
use warnings;

use Carp qw(croak);
use Scalar::Util qw(weaken refaddr);

use JavaScript;

my %Context;
my %Runtime;

sub new {
    my ($pkg, $runtime) = @_;

    my $self = jsc_create($runtime->{_impl});

    my $ptr = $self->jsc_ptr;
    
    $Context{$ptr} = $self;
    weaken($Context{$ptr});
    $Runtime{$ptr} = $runtime;
    
    return $self;
}

sub eval {
    my ($self, $source, $name) = @_;

    # Figure out name of script in case it isn't supplied to us
    my @caller = caller();
    $name ||= "$caller[0] line $caller[2]";
    
    my $rval = jsc_eval($self, $source, $name);

    return $rval;
}

sub set_pending_exception {
    my ($self, $exception) = @_;

    if(!defined($exception)){
        return;
    }
    my $rval = jsc_set_pending_exception($self, $exception); 

    return $rval;
}

sub eval_file {
    my ($self, $file) = @_;

    local $/ = undef;

    open my $in, "<$file" || die $!;
    my $source = <$in>;
    close($in);

    my $rval = jsc_eval($self, $source, $file);

    return $rval;
}

sub find {
    my ($self, $context) = @_;

    my $ptr = ref $context ? $context->ptr : $context;
    
    if (!exists $Context{$ptr}) {
        croak "Can't find context $context";
    }
    
    return $Context{$ptr};
}

sub call {
    my $self     = shift;
    my $function = shift;
    my $args     = [@_];
    
    return jsc_call($self, $function, $args);
}

sub can {
    my ($self, $method) = @_;

    return jsc_can($self, $method);
}

# Functions for binding perl stuff into JS namespace
sub bind_function {
    my $self = shift;
    my %args;

    # Handle 2 arg declaration and old 4 arg declaration
    if (@_ == 2) {
        %args = (name => shift, func => shift);
    }
    else {
        %args = @_;
    }

    # Check for name
    die "Missing argument 'name'\n" unless(exists $args{name});
    # TODO: fix    die "Argument 'name' must match /^[A-Za-z0-9_]+\$/" unless($args{name} =~ /^[A-Za-z0-9\_]+$/);

    # Check for func
    die "Missing argument 'func'\n" unless(exists $args{func});
    die "Argument 'func' is not a CODE reference\n" unless(ref($args{func}) eq 'CODE');

    $self->bind_value($args{name} => $args{func});

    return;
}

sub _resolve_method {
    my ($inspect, $croak_on_failure) = @_;

    return undef if !defined $inspect;
    return $inspect if ref $inspect  eq 'CODE';

    my ($pkg, $method) = $inspect =~ /^(?:(.*)::)?(.*)$/;
    $pkg = caller(1) if !defined $pkg || $pkg eq q{};
    $pkg = caller(2) if $pkg eq 'JavaScript::Context';

    my $callback = $pkg->can($method);
    croak "Can't resolve ${pkg}::${method}" if !defined $callback && $croak_on_failure;

    return $callback;
}

sub _extract_methods {
    my ($args, @arg_keys) = @_;

    my $method = {};

    for my $arg (@arg_keys) {
        if (exists $args->{$arg} && defined $args->{$arg}) {
            my $arg = $args->{$arg};
            
            if (ref $arg eq 'HASH') {
                for my $name (keys %$arg) {
                    $method->{$name} = _resolve_method($arg->{$name}, 1);
                }
            }
            elsif(ref $arg eq 'ARRAY') {
                for my $name (@$arg) {
                    $method->{$name} = _resolve_method($name, 1);
                }
            }
            else {
                my @methods = split /\s+/, $arg;
                for my $name (@methods) {
                    $method->{$name} = _resolve_method($name, 1);
                }
            }
        }
    }

    return $method;
}

sub _extract_properties {
    my ($args, @arg_keys) = @_;

    my $property = {};

    for my $arg (@arg_keys) {
        if (exists $args->{$arg} && defined $args->{$arg}) {
            my $arg = $args->{$arg};

            if (ref $arg eq 'HASH') {
                for my $name (keys %{$arg}) {
                    if (ref $arg->{$name} eq 'HASH') {
                        my $getter = _resolve_method($arg->{$name}->{getter}, 1);
                        my $setter = _resolve_method($arg->{$name}->{setter}, 1);
                        $property->{$name} = [ $getter, $setter ];
                    }
                    elsif (ref $arg->{$name} eq 'ARRAY') {
                        my @callbacks = @{$arg->{$name}};
                        my $getter = _resolve_method(shift @callbacks, 1);
                        my $setter = _resolve_method(shift @callbacks, 1);
                        $property->{$name} = [ $getter, $setter ];
                    }
                    elsif (ref $arg->{$name} eq '') {
                        my $getter = sub {
                            return $_[0]->{$name};
                        };

                        my $setter = !($arg->{$name} & JS_PROP_READONLY) ? sub {
                            $_[0]->{$name} = $_[1];
                        } :  undef;

                        $property->{$name} = [ $getter, $setter ];
                    }
                }
            }
            elsif (ref $arg eq 'ARRAY') {
                
            }
            else {
                my @properties = split /\s+/, $arg;
                for my $name (@properties) {
                }
            }
        }
    }

    return $property;
}

sub bind_class {
    my $self = shift;
    my %args = @_;
    
    # Check if name argument is valid
    die "Missing argument 'name'\n" unless(exists $args{name});
    die "Argument 'name' must match /^[A-Za-z0-9_]+\$/" unless($args{name} =~ /^[A-Za-z0-9\_]+$/);
    
    # Check if constructor is supplied and it's an coderef
    my $cons; 
    $cons = _resolve_method($args{constructor}, 1) if exists $args{constructor};
    
    if (exists $args{flags}) {
        die "Argument 'flags' is not numeric\n" unless($args{flags} =~ /^\d+$/);
    } else {
        $args{flags} = 0;
    }
    
    unless (exists $args{package}) {
        $args{package} = undef;
    }
    
    my $name = $args{name};
    my $pkg = $args{package} || $name;
    
    # Create a default constructor
    if (!defined $cons) {
        $cons = sub {
            $pkg->new(@_);
        };
    }
    
    # Per-object methods
    my $fs = _extract_methods(\%args, qw(methods fs));

    # Per-class methods
    my $static_fs = _extract_methods(\%args, qw(static_methods static_fs));

    # Per-object properties
    my $ps = _extract_properties(\%args, qw(properties ps));

    # Per-class properties
    my $static_ps = _extract_properties(\%args, qw(static_properties static_ps));

    # Flags
    my $flags = $args{flags};
    
    jsc_bind_class($self, $name, $pkg, $cons, $fs, $static_fs, $ps, $static_ps, $flags);
    
    return;
}

sub bind_object {
    my ($self, $name, $object) = @_;

    $self->bind_value($name => $object);

    return;
}

sub bind_value {
    my ($self, $name, $object, $opt) = @_;

    my @paths = split /\./, $name;
    my $current;
    for my $num (0..$#paths) {
        my $parent = join('.', @paths[0..$num-1]);
        my $abs = join('.', @paths[0..$num]);

        if($self->eval($abs)) {
            # We don't want to be able to rebind without unbinding first
            croak "${name} already exists, unbind it first" if $num == $#paths;

            next;
        } else {
          $@ = undef;
        }
        
        jsc_bind_value($self, $parent,
                       $paths[$num], $num == $#paths ? $object : {});
    }
    
    return;
}

sub unbind_value {
    my ($self, $name, $object, $opt) = @_;

    my @paths = split /\./, $name;
    $name = pop @paths;
    my $parent = join(".", @paths);
    jsc_unbind_value($self, $parent, $name);
}

sub set_branch_handler {
    my ($self, $handler) = @_;

    $handler = _resolve_method($handler, 1);

    jsc_set_branch_handler($self, $handler);
}

sub compile {
    my $self = shift;
    my $source = shift;

    my $script = JavaScript::Script->new($self, $source);
    return $script;
}

sub get_version {
    my ($self, $version) = @_;
    return jsc_get_version($self);
}

sub set_version {
    my ($self, $version) = @_;
    jsc_set_version($self, $version);
    1;
}


{
    my %options_by_tag = (
        strict  => 1,
        xml     => 1 << 6,
        jit     => 1 << 11,
    );

    sub get_options {
        my ($self) = @_;
        my $options = jsc_get_options($self);
        return grep { $options & $options_by_tag{$_} } keys %options_by_tag;
    }
    
    sub has_options {
        my $self = shift;
    
        my %options = map { $_ => 1 } $self->get_options;
        
        !exists $options{$_} && return 0 for @_;

        return 1;
    }
    
    sub toggle_options {
        my $self = shift;
        
        my $options = 0;
        for (@_) {
            $options |= 1 if exists $options_by_tag{lc $_};
        }
        
        jsc_toggle_options($self, $options);
        
        1;
    }
}

sub _destroy {
    my $self = shift;
    return unless $self;
    my $ptr = $self->jsc_ptr;
    return unless exists $Context{$ptr};
    delete $Context{$ptr};
    jsc_destroy($self);

    delete $Runtime{$ptr};
    
    return 1;
}

sub DESTROY {
  my $self = shift;
  $self->_destroy();
}

END {
    while (my ($k, $v) = %Context) {
        if ($Context{$k}) {
            delete $Context{$k};
            $v->_destroy();
        }
    }
}

1;
__END__