File Coverage

blib/lib/JE.pm

Criterion	Covered	Total	%
statement	352	388	90.7
branch	203	240	84.5
condition	33	45	73.3
subroutine	76	99	76.7
pod	13	13	100.0
total	677	785	86.2

package JE;

# If you are looking at the source code (which you are obviously doing
# if you are reading this),  note that  '# ~~~'  is my way of  marking
# something to be done still (except in this sentence).

# Note also that comments like "# E 7.1" refer to the indicated
# clause (7.1 in this case) in the ECMA-262 standard.

use 5.008004;
use strict;
use warnings; no warnings 'utf8';

our $VERSION = '0.066';

use Carp 'croak';
use JE::Code 'add_line_number';
use JE::_FieldHash;
use Scalar::Util 1.09 qw'blessed refaddr weaken';

our @ISA = 'JE::Object';

require JE::Null     ;
require JE::Number     ;
require JE::Object      ;
require JE::Object::Function;
require JE::Parser                             ;
require JE::Scope                             ;
require JE::String                          ;
require JE::Undefined                     ;

=encoding UTF-8

=head1 NAME

JE - Pure-Perl ECMAScript (JavaScript) Engine

=head1 VERSION

Version 0.066 (alpha release)

The API is still subject to change. If you have the time and the interest,
please experiment with this module (or even lend a hand :-).
If you have any ideas for the API, or would like to help with development,
please e-mail the author.

=head1 SYNOPSIS

  use JE;

  $j = new JE; # create a new global object

  $j->eval('({"this": "that", "the": "other"}["this"])');
  # returns "that"

  $parsed = $j->parse('new Array(1,2,3)');

  $rv = $parsed->execute; # returns a JE::Object::Array
  $rv->value;             # returns a Perl array ref

  $obj = $j->eval('new Object');
  # create a new object

  $foo = $j->{document}; # get property
  $j->{document} = $obj; # set property
  $j->{document} = {};   # gets converted to a JE::Object
  $j->{document}{location}{href}; # autovivification

  $j->method(alert => "text"); # invoke a method


  # create global function from a Perl subroutine:
  $j->new_function(print => sub { print @_, "\n" } );

  $j->eval(<<'--end--');
          function correct(s) {
                  s = s.replace(/[EA]/g, function(s){
                          return ['E','A'][+(s=='E')]
                  })
                  return s.charAt(0) +
                         s.substring(1,4).toLowerCase() +
                         s.substring(4)
          }
          print(correct("ECMAScript")) // :-)
  --end--

=head1 DESCRIPTION

JE, short for JavaScript::Engine (imaginative, isn't it?), is a pure-Perl
JavaScript engine. Here are some of its
strengths:

=over 4

=item -

Easy to install (no C compiler necessary*)

=item -

The parser can be extended/customised to support extra (or
fewer) language features (not yet complete)

=item -

All JavaScript datatypes can be manipulated directly from Perl (they all
have overloaded operators)

=item -

The JavaScript datatypes provide C methods for compatibility with
L.

=back

JE's greatest weakness is that it's slow (well, what did you expect?).  It
also uses and leaks lots of memory.  (There is an experimental
L module that solves this if you load
it first and then call C on the JE object when
you have finished with it.)

* If you are using perl 5.9.3 or lower, then L is
required. Recent versions of it require L, an XS module
(which requires a compiler of course), but version 0.02 of the former is
just pure Perl with no XS dependencies.

There is currently an experimental version of the run-time engine, which is
supposed to be faster, although it currently makes compilation slower. (If
you serialise the compiled code and use that, you should notice a
speed-up.) It will eventually replace the current one when it is complete.
(It does not yet respect tainting or max_ops, or report line numbers
correctly.) You can activate it by setting to 1 the ridiculously named
YES_I_WANT_JE_TO_OPTIMISE environment variable, which is just a
temporary hack that will later be removed.

=head1 USAGE

=head2 Simple Use

If you simply need to run a few JS functions from Perl, create a new JS
environment like this:

  my $je = new JE;

If necessary, make Perl subroutines available to JavaScript:

  $je->new_function(warn => sub { warn @_ });
  $je->new_function(ok => \&Test::More::ok);

Then pass the JavaScript functions to C:

  $je->eval(<<'___');

  function foo() {
      return 42
  }
  // etc.
  ___

  # or perhaps:
  use File::Slurp;
  $je->eval(scalar read_file 'functions.js');

Then you can access those function from Perl like this:

  $return_val = $je->{foo}->();
  $return_val = $je->eval('foo()');

The return value will be a special object that, when converted to a string,
boolean or number, will behave exactly as in JavaScript. You can also use
it as a hash, to access or modify its properties. (Array objects can be
used as arrays, too.) To call one of its
JS methods, you should use the C method:
C<< $return_val->method('foo') >>. See L for more information.

=head2 Custom Global Objects

To create a custom global object, you have to subclass JE. For instance,
if all you need to do is add a C property that refers to the global
object, then override the C method like this:

  package JEx::WithSelf;
  @ISA = 'JE';
  sub new {
      my $self = shift->SUPER::new(@_);
      $self->{self} = $self;
      return $self;
  }

=head2 Using Perl Objects from JS

See C, below.

=head2 Writing Custom Data Types

See L.

=head1 METHODS

See also L<< C >>, which this
class inherits from, and L<< C >>.

=over 4

=item $j = JE->new( %opts )

This class method constructs and returns a new JavaScript environment, the
JE object itself being the global object.

The (optional) options it can take are C and C, which
correspond to the methods listed below.

=cut

our $s = qr.[\p{Zs}\s\ck]*.;

sub new {
	my $class = shift;

	# I can't use the usual object and function constructors, since
	# they both rely on the existence of  the global object and its
	# 'Object' and 'Function' properties.

	if(ref $class) {
		croak "JE->new is a class method and cannot be called " .
			"on a" . ('n' x ref($class) =~ /^[aoeui]/i) . ' ' .
			 ref($class). " object."
	}

	# Commented lines here are just for reference:
	my $self = bless \{
		#prototype => (Object.prototype)
		#global => ...
		keys => [],
		props => {
			Object => bless(\{
				#prototype => (Function.prototype)
				#global => ...
				#scope => bless [global], JE::Scope
				func_name => 'Object',
				func_argnames => [],
				func_args => ['global','args'],
				function => sub { # E 15.2.1
					return JE::Object->new( @_ );
				},
				constructor_args => ['global','args'],
				constructor => sub {
					return JE::Object->new( @_ );
				},
				keys => [],
				props => {
					#length => JE::Number->new(1),
					prototype => bless(\{
						#global => ...
						keys => [],
						props => {},
					}, 'JE::Object')
				},
				prop_readonly => {
					prototype => 1,
					length    => 1,
				 },
				prop_dontdel  => {
					prototype => 1,
					length    => 1,
				 },
			}, 'JE::Object::Function'),
			Function => bless(\{
				#prototype => (Function.prototype)
				#global => ...
				#scope => bless [global], JE::Scope
				func_name => 'Function',
				func_argnames => [],
				func_args => ['scope','args'],
				function => sub { # E 15.3.1
					JE::Object::Function->new(
						$${$_[0][0]}{global},
						@_[1..$#_]
					);
				},
				constructor_args => ['scope','args'],
				constructor => sub {
					JE::Object::Function->new(
						$${$_[0][0]}{global},
						@_[1..$#_]
					);
				},
				keys => [],
				props => {
					#length => JE::Number->new(1),
					prototype => bless(\{
						#prototype=>(Object.proto)
						#global => ...
						func_argnames => [],
						func_args => [],
						function => '',
						keys => [],
						props => {},
					}, 'JE::Object::Function')
				},
				prop_readonly => {
					prototype => 1,
					length    => 1,
				 },
				prop_dontdel  => {
					prototype => 1,
					length    => 1,
				 },
			}, 'JE::Object::Function'),
		},
	}, $class;

	my $obj_proto =
	    (my $obj_constr  = $self->prop('Object'))  ->prop('prototype');
	my $func_proto =
	    (my $func_constr = $self->prop('Function'))->prop('prototype');

	$self->prototype( $obj_proto );
	$$$self{global} = $self;

	$obj_constr->prototype( $func_proto );
	$$$obj_constr{global} = $self;
	my $scope = $$$obj_constr{scope} =  bless [$self], 'JE::Scope';

	$func_constr->prototype( $func_proto );
	$$$func_constr{global} = $self;
	$$$func_constr{scope} = $scope;

	$$$obj_proto{global} = $self;

	$func_proto->prototype( $obj_proto );
	$$$func_proto{global} = $self;

	$obj_constr ->prop(
	    {name=>'length',dontenum=>1,value=>new JE::Number $self,1}
	);
	$func_constr->prop(
	    {name=>'length',dontenum=>1,value=>new JE::Number $self,1}
	);
	$func_proto->prop({name=>'length', value=>0, dontenum=>1});

	if($JE::Destroyer) {
		JE::Destroyer'register($_) for $obj_constr, $func_constr;
	}

	# Before we add anything else, we need to make sure that our global
	# true/false/undefined/null values are available.
	@{$$self}{qw{ t f u n }} = (
		JE::Boolean->new($self, 1),
		JE::Boolean->new($self, 0),
		JE::Undefined->new($self),
		JE::Null->new($self),
	);

	$self->prototype_for('Object', $obj_proto);
	$self->prototype_for('Function', $func_proto);
	JE::Object::_init_proto($obj_proto);
	JE::Object::Function::_init_proto($func_proto);


	# The rest of the constructors
	# E 15.1.4
	$self->prop({
		name => 'Array',
		autoload =>
			'require JE::Object::Array;
			 JE::Object::Array::_new_constructor($global)',
		dontenum => 1,
	});
	$self->prop({
		name => 'String',
		autoload =>
			'require JE::Object::String;
			JE::Object::String::_new_constructor($global)',
		dontenum => 1,
	});
	$self->prop({
		name => 'Boolean',
		autoload =>
		    'require JE::Object::Boolean;
		    JE::Object::Boolean::_new_constructor($global)',
		dontenum => 1,
	});
	$self->prop({
		name => 'Number',
		autoload =>
			'require JE::Object::Number;
			JE::Object::Number::_new_constructor($global)',
		dontenum => 1,
	});
	$self->prop({
		name => 'Date',
		autoload =>
			'require JE::Object::Date;
			JE::Object::Date::_new_constructor($global)',
		dontenum => 1,
	});
	$self->prop({
		name => 'RegExp',
		autoload =>
			'require JE::Object::RegExp;
			 JE::Object::RegExp->new_constructor($global)',
		dontenum => 1,
	});
	$self->prop({
		name => 'Error',
		autoload =>
			'require JE::Object::Error;
			 JE::Object::Error::_new_constructor($global)',
		dontenum => 1,
	});
	# No EvalError
	$self->prop({
		name => 'RangeError',
		autoload => 'require JE::Object::Error::RangeError;
		             JE::Object::Error::RangeError
		              ->_new_subclass_constructor($global)',
		dontenum => 1,
	});
	$self->prop({
		name => 'ReferenceError',
		autoload => 'require JE::Object::Error::ReferenceError;
		             JE::Object::Error::ReferenceError
		              ->_new_subclass_constructor($global)',
		dontenum => 1,
	});
	$self->prop({
		name => 'SyntaxError',
		autoload => 'require JE::Object::Error::SyntaxError;
		             JE::Object::Error::SyntaxError
		              ->_new_subclass_constructor($global)',
		dontenum => 1,
	});
	$self->prop({
		name => 'TypeError',
		autoload => 'require JE::Object::Error::TypeError;
		             JE::Object::Error::TypeError
		              ->_new_subclass_constructor($global)',
		dontenum => 1,
	});
	$self->prop({
		name => 'URIError',
		autoload => 'require JE::Object::Error::URIError;
		             JE::Object::Error::URIError
		              ->_new_subclass_constructor($global)',
		dontenum => 1,
	});

	# E 15.1.1
	$self->prop({
		name      => 'NaN',
		value     => JE::Number->new($self, 'NaN'),
		dontenum  => 1,
		dontdel   => 1,
	});
	$self->prop({
		name      => 'Infinity',
		value     => JE::Number->new($self, 'Infinity'),
		dontenum  => 1,
		dontdel   => 1,
	});
	$self->prop({
		name      => 'undefined',
		value     => $self->undefined,
		dontenum  => 1,
		dontdel   => 1,
	});


	# E 15.1.2
	$self->prop({
		name      => 'eval',
		value     => JE::Object::Function->new({
			scope    => $self,
			name     => 'eval',
			argnames => ['x'],
			function_args => [qw< args >],
			function => sub {
				my($code) = @_;
				return $self->undefined unless defined
					$code;
				return $code if typeof $code ne 'string';
				my $old_at = $@; # hope it's not tied
				defined (my $tree =
					($JE::Code::parser||$self)
					->parse($code))
					or die;
				my $ret = execute $tree
					$JE::Code::this,
					$JE::Code::scope, 1;

				ref $@ ne '' and die;

				$@ = $old_at;
				$ret;
			},
			no_proto => 1,
		}),
		dontenum  => 1,
	});
	$self->prop({
		name  => 'parseInt',
		value => JE::Object::Function->new({
			scope  => $self,
			name   => 'parseInt', # E 15.1.2.2
			argnames => [qw/string radix/],
			no_proto => 1,
			function_args => [qw< scope args >],
			function => sub {
				my($scope,$str,$radix) = @_;
				$radix = defined $radix
				 ? $radix->to_number->value
				 : 0;
				$radix == $radix and $radix != $radix+1
					or $radix = 0;

				if(defined $str) {
					($str = $str->to_string)
						=~ s/^$s//;
				} else { $str = 'undefined' };
				my $sign = $str =~ s/^([+-])//
					? (-1,1)[$1 eq '+']
					:  1;
				$radix = (int $radix) % 2 ** 32;
				$radix -= 2**32 if $radix >= 2**31;
				$radix ||= $str =~ /^0x/i
				?	16
				:	10
				;
				$radix == 16 and
					$str =~ s/^0x//i;

				$radix < 2 || $radix > 36 and return
					JE::Number->new($self,'nan');

				my @digits = (0..9, 'a'..'z')[0
					..$radix-1];
				my $digits = join '', @digits;
				$str =~ /^([$digits]*)/i;
				$str = $1;

				my $ret;
				if(!length $str){
					$ret= 'nan' ;
				}
				elsif($radix == 10) {
					$ret= $sign * $str;
				}
				elsif($radix == 16) {
					$ret= $sign * hex $str;
				}
				elsif($radix == 8) {
					$ret= $sign * oct $str;
				}
				elsif($radix == 2) {
					$ret= $sign * eval
						"0b$str";
				}
				else { my($num, $place);
				for (reverse split //, $str){
					$num += ($_ =~ /[0-9]/ ? $_
					    : ord(uc) - 55)
					    * $radix**$place++
				}
				$ret= $num*$sign;
				}

				return JE::Number->new($self,$ret);
			},
		}),
		dontenum  => 1,
	});
	$self->prop({
		name  => 'parseFloat',
		value => JE::Object::Function->new({
			scope  => $self,
			name   => 'parseFloat', # E 15.1.2.3
			argnames => [qw/string/],
			no_proto => 1,
			function_args => [qw< scope args >],
			function => sub {
				my($scope,$str,$radix) = @_;

				defined $str or $str = '';
				ref $str eq 'JE::Number' and return $str;
				ref $str eq 'JE::Object::Number'
				 and return $str->to_number;
				return JE::Number->new($self, $str =~
					/^$s
					  (
					    [+-]?
					    (?:
					      (?=[0-9]|\.[0-9]) [0-9]*
					      (?:\.[0-9]*)?
					      (?:[Ee][+-]?[0-9]+)?
					        |
					      Infinity
					    )
					  )
					/ox
					?  $1 : 'nan');
			},
		}),
		dontenum  => 1,
	});
	$self->prop({
		name  => 'isNaN',
		value => JE::Object::Function->new({
			scope  => $self,
			name   => 'isNaN',
			argnames => [qw/number/],
			no_proto => 1,
			function_args => ['args'],
			function => sub {
				JE::Boolean->new($self,
					!defined $_[0] ||
					shift->to_number->id eq 'num:nan');
			},
		}),
		dontenum  => 1,
	});
	$self->prop({
		name  => 'isFinite',
		value => JE::Object::Function->new({
			scope  => $self,
			name   => 'isFinite',
			argnames => [qw/number/],
			no_proto => 1,
			function_args => ['args'],
			function => sub {
				my $val = shift;
				JE::Boolean->new($self,
					defined $val &&
					($val = $val->to_number->value)
						== $val &&
					$val + 1 != $val
				);
			},
		}),
		dontenum  => 1,
	});

	# E 15.1.3
	$self->prop({
		name  => 'decodeURI',
		autoload => q{ require 'JE/escape.pl';
		    JE::Object::Function->new({
		        scope  => $global,
		        name   => 'decodeURI',
		        argnames => [qw/encodedURI/],
		        no_proto => 1,
		        function_args => ['scope','args'],
		        function => \&JE'_decodeURI,
		    })
		},
		dontenum  => 1,
	});
	$self->prop({
		name  => 'decodeURIComponent',
		autoload => q{ require 'JE/escape.pl';
		    JE::Object::Function->new({
			scope  => $global,
			name   => 'decodeURIComponent',
			argnames => [qw/encodedURIComponent/],
			no_proto => 1,
			function_args => ['scope','args'],
			function => \&JE'_decodeURIComponent
		    })
		},
		dontenum  => 1,
	});
	$self->prop({
		name  => 'encodeURI',
		autoload => q{ require 'JE/escape.pl';
		    JE::Object::Function->new({
			scope  => $global,
			name   => 'encodeURI',
			argnames => [qw/uri/],
			no_proto => 1,
			function_args => ['scope','args'],
			function => \&JE'_encodeURI,
		    })
		},
		dontenum  => 1,
	});
	$self->prop({
		name  => 'encodeURIComponent',
		autoload => q{ require 'JE/escape.pl';
		    JE::Object::Function->new({
			scope  => $global,
			name   => 'encodeURIComponent',
			argnames => [qw/uriComponent/],
			no_proto => 1,
			function_args => ['scope','args'],
			function => \&JE'_encodeURIComponent,
		    })
		},
		dontenum  => 1,
	});

	# E 15.1.5 / 15.8
	$self->prop({
		name  => 'Math',
		autoload => 'require JE::Object::Math;
		             JE::Object::Math->new($global)',
		dontenum  => 1,
	});

	# E B.2
	$self->prop({
		name  => 'escape',
		autoload => q{
			require 'JE/escape.pl';
			JE::Object::Function->new({
				scope  => $global,
				name   => 'escape',
				argnames => [qw/string/],
				no_proto => 1,
				function_args => ['scope','args'],
				function => \&JE'_escape,
			})
		},
		dontenum  => 1,
	});
	$self->prop({
		name  => 'unescape',
		autoload => q{
			require 'JE/escape.pl';
			JE::Object::Function->new({
				scope  => $global,
				name   => 'unescape',
				argnames => [qw/string/],
				no_proto => 1,
				function_args => ['scope','args'],
				function => \&JE'_unescape,
			})
		},
		dontenum  => 1,
	});


	# Constructor args
	my %args = @_;
	$$$self{max_ops} = delete $args{max_ops};
	$$$self{html_mode} = delete $args{html_mode};

	$self;
}




=item $j->parse( $code, $filename, $first_line_no )

C parses the code contained in C<$code> and returns a parse
tree (a JE::Code object).

If the syntax is not valid, C will be returned and C<$@> will
contain an
error message. Otherwise C<$@> will be a null string.

The JE::Code class provides the method
C for executing the
pre-compiled syntax tree.

C<$filename> and C<$first_line_no>, which are both optional, will be stored
inside the JE::Code object and used for JS error messages. (See also
L in the JE::Code man page.)

=item $j->compile( STRING )

Just an alias for C.

=cut

sub parse {
	goto &JE::Code::parse;
}
*compile = \&parse;


=item $j->eval( $code, $filename, $lineno )

C evaluates the JavaScript code contained in C<$code>. E.g.:

  $j->eval('[1,2,3]') # returns a JE::Object::Array which can be used as
                      # an array ref

If C<$filename> and C<$lineno> are specified, they will be used in error
messages. C<$lineno> is the number of the first line; it defaults to 1.

If an error occurs, C will be returned and C<$@> will contain the
error message. If no error occurs, C<$@> will be a null string.

This is actually just
a wrapper around C and the C method of the
JE::Code class.

If the JavaScript code evaluates to an lvalue, a JE::LValue object will be
returned. You can use this like any other return value (e.g., as an array
ref if it points to a JS array). In addition, you can use the C and
C methods to set/get the value of the property to which the lvalue
refers. (See also L.) E.g., this will create a new object
named C:

  $j->eval('this.document')->set({});

Note that I used C rather than just C, since the
latter would throw an error if the variable did not exist.

=cut

sub eval {
	my $code = shift->parse(@_);
	$@ and return;

	$code->execute;
}




=item $j->new_function($name, sub { ... })

=item $j->new_function(sub { ... })

This creates and returns a new function object. If $name is given,
it will become a property of the global object.

Use this to make a Perl subroutine accessible from JavaScript.

For more ways to create functions, see L.

This is actually a method of JE::Object, so you can use it on any object:

  $j->{Math}->new_function(double => sub { 2 * shift });


=item $j->new_method($name, sub { ... })

This is just like C, except that, when the function is
called, the subroutine's first argument (number 0) will be the object
with which the function is called. E.g.:

  $j->eval('String.prototype')->new_method(
          reverse => sub { scalar reverse shift }
  );
  # ... then later ...
  $j->eval(q[ 'a string'.reverse() ]); # returns 'gnirts a'


=item $j->max_ops

=item $j->max_ops( $new_value )

Use this to set the maximum number of operations that C (or
JE::Code's C) will run before terminating. (You can use this for
runaway scripts.) The exact method of counting operations
is consistent from one run to another, but is not guaranteed to be consistent between versions of JE. In the current implementation, an
operation means an expression or sub-expression, so a simple C
statement with no arguments is not counted.

With no arguments, this method returns the current value.

As shorthand, you can pass C<< max_ops => $foo >> to the constructor.

If the number of operations is exceeded, then C will return undef and
set C<$@> to a 'max_ops (xxx) exceeded.

=cut

sub max_ops {
	my $self = shift;
	if(@_) { $$$self{max_ops} = shift; return }
	else { return $$$self{max_ops} }
}


=item $j->html_mode

=item $j->html_mode( $new_value )

Use this to turn on 'HTML mode', in which HTML comment delimiters are
treated much like C. C is a boolean. Since this violates
ECMAScript, it is off by  default.

With no arguments, this method returns the current value.

As shorthand, you can pass C<< html_mode => 1 >> to the constructor.

=cut

sub html_mode {
	my $self = shift;
	if(@_) { $$$self{html_mode} = shift; return }
	else { return $$$self{html_mode} }
}


=item $j->upgrade( @values )

This method upgrades the value or values given to it. See
L for more detail.


If you pass it more
than one
argument in scalar context, it returns the number of arguments--but that
is subject to change, so don't do that.

=cut

fieldhash my %wrappees;

sub upgrade {
	my @__;
	my $self = shift;
	my($classes,$proxy_cache);
	for (@_) {
		if (defined blessed $_) {
			$classes or ($classes,$proxy_cache) =
				@$$self{'classes','proxy_cache'};
			my $ident = refaddr $_;
			my $class = ref;
			push @__, exists $$classes{$class}
			    ? exists $$proxy_cache{$ident}
			        ? $$proxy_cache{$ident}
			        : ($$proxy_cache{$ident} =
			            exists $$classes{$class}{wrapper}
			                ? do {
			                   weaken( $wrappees{
			                    my $proxy
			                     = $$classes{$class}{wrapper}(
			                        $self,$_
			                       )
			                   } = $_);
			                   $proxy
			                  }
			                : JE::Object::Proxy->new($self,$_)
			           )
			    : $_;
		} else {
			push @__,
			  !defined()
			?	$self->undefined
			: ref($_) eq 'ARRAY'
			?	JE::Object::Array->new($self, $_)
			: ref($_) eq 'HASH'
			?	JE::Object->new($self, { value => $_ })
			: ref($_) eq 'CODE'
			?	JE::Object::Function->new($self, $_)
			: $_ eq '0' || $_ eq '-0'
			?	JE::Number->new($self, 0)
			:	JE::String->new($self, $_)
			;
		}
	}
	@__ > 1 ? @__ : @__ == 1 ? $__[0] : ();
}

sub _upgr_def {
# ~~~ maybe I should make this a public method named upgrade_defined
	return defined $_[1] ? shift->upgrade(shift) : undef
}


=item $j->undefined

Returns the JavaScript undefined value.

=cut

sub undefined {
	$${+shift}{u}
}




=item $j->null

Returns the JavaScript null value.

=cut

sub null {
	$${+shift}{n}
}



=item $j->true

Returns the JavaScript true value.

=item $j->false

Returns the JavaScript false value.

=cut

sub true  { $${+shift}{t} }
sub false { $${+shift}{f} }




=item $j->bind_class( LIST )

(This method can create a potential security hole. Please see L,
below.)

=back

=head2 Synopsis

 $j->bind_class(
     package => 'Net::FTP',
     name    => 'FTP', # if different from package
     constructor => 'new', # or sub { Net::FTP->new(@_) }

     methods => [ 'login','get','put' ],
     # OR:
     methods => {
         log_me_in => 'login', # or sub { shift->login(@_) }
         chicken_out => 'quit',
     }
     static_methods => {
         # etc. etc. etc.
     }
     to_primitive => \&to_primitive # or a method name
     to_number    => \&to_number
     to_string    => \&to_string

     props => [ 'status' ],
     # OR:
     props => {
         status => {
             fetch => sub { 'this var never changes' }
             store => sub { system 'say -vHysterical hah hah' }
         },
         # OR:
         status => \&fetch_store # or method name
     },
     static_props => { ... }

     hash  => 1, # Perl obj can be used as a hash
     array => 1, # or as an array
     # OR (not yet implemented):
     hash  => 'namedItem', # method name or code ref
     array => 'item',       # likewise
     # OR (not yet implemented):
     hash => {
         fetch => 'namedItem',
         store => sub { shift->{+shift} = shift },
     },
     array => {
         fetch => 'item',
         store => sub { shift->[shift] = shift },
     },

     isa => 'Object',
     # OR:
     isa => $j->{Object}{prototype},
 );

 # OR:

 $j->bind_class(
     package => 'Net::FTP',
     wrapper => sub { new JE_Proxy_for_Net_FTP @_ }
 );


=head2 Description

(Some of this is random order, and probably needs to be rearranged.)

This method binds a Perl class to JavaScript. LIST is a hash-style list of
key/value pairs. The keys, listed below, are all optional except for
C or
C--you must specify at least one of the two.

Whenever it says you can pass a method name to a particular option, and
that method is expected to return a value (i.e., this does not apply to
C<< props => { property_name => { store => 'method' } } >>), you may append
a colon and a data type (such as ':String') to the method name, to indicate
to what JavaScript type to convert the return value. Actually, this is the
name of a JS function to which the return value will be passed, so 'String'
has to be capitalised. This also means than you can use 'method:eval' to
evaluate the return value of 'method' as JavaScript code. One exception to
this is that the special string ':null' indicates that Perl's C
should become JS's C, but other values will be converted the default
way. This is useful, for instance, if a method should return an object or
C, from JavaScript's point of view. This ':' feature does not stop
you from using double colons in method names, so you can write
C<'Package::method:null'> if you like, and rest assured that it will split
on the last colon. Furthermore, just C<'Package::method'> will also work.
It won't split it at all.

=over 4

=item package

The name of the Perl class. If this is omitted, C will be used
instead.

=item name

The name the class will have in JavaScript. This is used by
C and as the name of the constructor. If
omitted, C will be used.

=item constructor => 'method_name'

=item constructor => sub { ... }

If C is given a string, the constructor will treat it as the
name of a class method of C.

If it is a coderef, it will be used as the constructor.

If this is omitted, the constructor will raise an error when called. If
there is already a constructor with the same name, however, it will be left
as it is (though methods will still be added to its prototype object). This
allows two Perl classes to be bound to a single JavaScript class:

 $j->bind_class( name => 'Foo', package => 'Class::One', methods => ... );
 $j->bind_class( name => 'Foo', package => 'Class::Two' );

=item methods => [ ... ]

=item methods => { ... }

If an array ref is supplied, the named methods will be bound to JavaScript
functions of the same names.

If a hash ref is used, the keys will be the
names of the methods from JavaScript's point of view. The values can be
either the names of the Perl methods, or code references.

=item static_methods

Like C but they will become methods of the constructor itself, not
of its C property.

=item to_primitive => sub { ... }

=item to_primitive => 'method_name'

When the object is converted to a primitive value in JavaScript, this
coderef or method will be called. The first argument passed will, of
course, be the object. The second argument will be the hint ('number' or
'string') or will be omitted.

If to_primitive is omitted, the usual valueOf and
toString methods will be tried as with built-in JS
objects, if the object does not have overloaded string/boolean/number
conversions. If the object has even one of those three, then conversion to
a primitive will be the same as in Perl.

If C<< to_primitive => undef >> is specified, primitivisation
without a hint (which happens with C<< < >> and C<==>) will throw a
TypeError.

=item to_number

If this is omitted, C will be
used.
If set to undef, a TypeError will be thrown whenever the
object is numified.

=item to_string

If this is omitted, C will be
used.
If set to undef, a TypeError will be thrown whenever the
object is strung.

=item props => [ ... ]

=item props => { ... }

Use this to add properties that will trigger the provided methods or
subroutines when accessed. These property definitions can also be inherited
by subclasses, as long as, when the subclass is registered with
C, the superclass is specified as a string (via C, below).

If this is an array ref, its elements will be the names of the properties.
When a property is retrieved, a method of the same name is called. When a
property is set, the same method is called, with the new value as the
argument.

If a hash ref is given, for each element, if the value is a simple scalar,
the property named by the key will trigger the method named by the value.
If the value is a coderef, it will be called with the object as its
argument when the variable is read, and with the object and
the new
value as its two arguments when the variable is set.
If the value is a hash ref, the C and C keys will be
expected to be either coderefs or method names. If only C is given,
the property will be read-only. If only C is given, the property
will
be write-only and will appear undefined when accessed. (If neither is
given,
it will be a read-only undefined property--really useful.)

=item static_props

Like C but they will become properties of the constructor itself,
not
of its C property.

=item hash

If this option is present, then this indicates that the Perl object
can be used
as a hash. An attempt to access a property not defined by C or
C will result in the retrieval of a hash element instead (unless
the property name is a number and C is specified as well).

=begin comment

There are several values this option can take:

 =over 4

 =item *

One of the strings '1-way' and '2-way' (also 1 and 2 for short). This will
indicate that the object being wrapped can itself be used as a hash.

=end comment

The value you give this option should be one of the strings '1-way' and
'2-way' (also 1 and 2 for short).

If
you specify '1-way', only properties corresponding to existing hash
elements will be linked to those elements;
properties added to the object from JavaScript will
be JavaScript's own, and will not affect the wrapped object. (Consider how
node lists and collections work in web browsers.)

If you specify '2-way', an attempt to create a property in JavaScript will
be reflected in the underlying object.

=begin comment

=item *

A method name (that does not begin with a number). This method will be
called on the object with the object as the first arg (C<$_[0]>), the
property name as the second, and, if an assignment is being made, the new
value as the third. This will be a one-way hash.

=item *

A reference to a subroutine. This sub will be called with the same
arguments as a method. Again, this will be a one-way hash.

=item *

A hash with C and C keys, which should be set to method names
or coderefs. Actually, you may omit C to create a one-way binding,
as per '1-way', above, except that the properties that correspond to hash
keys will be read-only as well.

 =back

=end comment

B Make this accept '1-way:String', etc.

=item array

This is just like C, but for arrays. This will also create a property
named 'length'.

=for comment
if passed '1-way' or '2-way'.

B Make this accept '1-way:String', etc.

=begin comment

=item keys

This should be a method name or coderef that takes the object as its first
argument and
returns a list of hash keys. This only applies if C is specified
and passed a method name, coderef, or hash.

=end comment

=item unwrap => 1

If you specify this and it's true, objects passed as arguments to the
methods or code
refs specified above are 'unwrapped' if they are proxies for Perl objects
(see below). And null and undefined are converted to C.

This is experimental right now. I might actually make this the default.
Maybe this should provide more options for fine-tuning, or maybe what is
currently the default behaviour should be removed. If
anyone has any opinions on this, please e-mail the author.

=item isa => 'ClassName'

=item isa => $prototype_object

(Maybe this should be renamed 'super'.)

The name of the superclass. 'Object' is the default. To make this new
class's prototype object have no prototype, specify
C. Instead of specifying the name of the superclass, you
can
provide the superclass's prototype object.

If you specify a name, a constructor function by that name must already
exist, or an exception will be thrown. (I supposed I could make JE smart
enough to defer retrieving the prototype object until the superclass is
registered. Well, maybe later.)

=item wrapper => sub { ... }

If C is specified, all other arguments will be ignored except for
C (or C if C is not present).

When an object of the Perl class in question is 'upgraded,' this subroutine
will be called with the global object as its first argument and the object
to be 'wrapped' as the second. The subroutine is expected to return
an object compatible with the interface described in L.

If C is supplied, no constructor will be created.

=back

After a class has been bound, objects of the Perl class will, when passed
to JavaScript (or the C method), appear as instances of the
corresponding JS class. Actually, they are 'wrapped up' in a proxy object
(a JE::Object::Proxy
object), that provides the interface that JS operators require (see
L). If the
object is passed back to Perl, it is the I
not the original object that is returned. The proxy's C method will
return the original object. I if the C option above is used
when a class is bound, the original Perl object will be passed to any
methods or properties belonging to that class. B
subject to change.> See L, above.

Note that, if you pass a Perl object to JavaScript before binding its
class,
JavaScript's reference to it (if any) will remain as it is, and will not be
wrapped up inside a proxy object.

To use Perl's overloading within JavaScript, well...er, you don't have to
do
anything. If the object has C<"">, C<0+> or C overloading, that will
automatically be detected and used.

=cut

sub _split_meth { $_[0] =~ /(.*[^:]):([^:].*)/s ? ($1, $2) : $_[0] }
# This function splits a method specification  of  the  form  'method:Func'
# into its two constituent parts, returning ($_[0],undef) if it is a simple
# method name.  The  [^:]  parts of the regexp are  to  allow  things  like
# "HTML::Element::new:null"  and to prevent  "Foo::bar"  from being turned
# into qw(Foo: bar).

sub _cast {
	my ($self,$val,$type) = @_;
	return $self->upgrade($val) unless defined $type;
	if($type eq 'null') {
		defined $val ? $self->upgrade($val) : $self->null
	}
	else {
		$self->prop($type)->call($self->upgrade($val));
	}
}

sub _unwrap {
	my ($self)  = shift;
	my @ret;
	for(@_){
		push @ret,
		   ref =~  # Check the most common classes for efficiency.
		    /^JE::(?:Object::Proxy(?:::Array)?|Undefined|Null)\z/
			? $_->value
		 : exists $wrappees{$_}
			? $wrappees{$_}
			: $_
	}
	@ret;
}

sub bind_class {
	require JE::Object::Proxy;

	my $self = shift;
	my %opts = @_;
#{ no warnings;
#warn refaddr $self, " ", $opts{name} , ' ' ,$opts{package}; }


	# &upgrade relies on this, because it
	# takes the value of  ->{proxy_cache},
	# sticks it in a scalar, then modifies
	# it through that scalar.
	$$$self{proxy_cache} ||= &fieldhash({}); # & to bypass prototyping

	if(exists $opts{wrapper}) { # special case
		my $pack = $opts{qw/name package/[exists $opts{package}]};
		$$$self{classes}{$pack} = {wrapper => $opts{wrapper}};
		return;
	}

	my($pack, $class);
	if(exists $opts{package}) {
		$pack = "$opts{package}";
		$class = exists $opts{name} ? $opts{name} : $pack;
	}
	else {
		$class = $opts{name};
		$pack = "$class";
	}

	my %class = ( name => $class );
	$$$self{classes}{$pack} = $$$self{classes_by_name}{$class} =
		\%class;

	my $unwrap = delete $opts{unwrap};

	my ($constructor,$proto,$coderef);
	if (exists $opts{constructor}) {
		my $c = $opts{constructor};

		$coderef = ref eq 'CODE'
			? sub { $self->upgrade(scalar &$c(@_)) }
			: sub { $self->upgrade(scalar $pack->$c(@_)) };
	}
	else {
		$coderef = sub {
			die JE::Code::add_line_number(
				"$class cannot be instantiated");
		 };
		$constructor = $self->prop($class);
		defined $constructor and $constructor->typeof ne 'function'
		 and $constructor = undef;
	}
	$class{prototype} = $proto = ( $constructor || $self->prop({
		name => $class,
		value => $constructor = JE::Object::Function->new({
			name => $class,
			scope => $self,
			function => $coderef,
			function_args => ['args'],
			constructor => $coderef,
			constructor_args => ['args'],
		}),
	}) )->prop('prototype');

	my $super;
	if(exists $opts{isa}) {
		my $isa = $opts{isa};
		$proto->prototype(
		    !defined $isa || defined blessed $isa
		      ? $isa
		      : do {
		        $super = $isa;
		        defined(my $super_constr = $self->prop($isa)) ||
			  croak("JE::bind_class: The $isa" .
		                " constructor does not exist");
		        $super_constr->prop('prototype')
		      }
		);
	}

	if(exists $opts{methods}) {
		my $methods = $opts{methods};
		if (ref $methods eq 'ARRAY') { for (@$methods) {
			my($m, $type) = _split_meth $_;
			if (defined $type) {
				$proto->new_method(
					$m => $unwrap
					? sub {
					  $self->_cast(
					    scalar shift->value->$m(
					      $self->_unwrap(@_)),
					    $type
					  );
					}
					: sub {
					  $self->_cast(
					    scalar shift->value->$m(@_),
					    $type
					  );
					}
				);
			}else {
				$proto->new_method(
					$m => $unwrap
					? sub { shift->value->$m(
						$self->_unwrap(@_)) }
					: sub { shift->value->$m(@_) },
				);
			}
		}} else { # it'd better be a hash!
		while( my($name, $m) = each %$methods) {
			if(ref $m eq 'CODE') {
				$proto->new_method(
					$name => $unwrap
					? sub {
					    &$m($self->_unwrap(@_))
					  }
					: sub {
					    &$m($_[0]->value,@_[1..$#_])
					  }
				);
			} else {
				my ($method, $type) = _split_meth $m;
				$proto->new_method(
				  $name => defined $type
				    ? $unwrap
				      ? sub {
				        $self->_cast(
				          scalar shift->value->$method(
				            $self->_unwrap(@_)),
				          $type
				        );
				      }
				      : sub {
				        $self->_cast(
				          scalar shift->value->$method(@_),
				          $type
				        );
				      }
				    : $unwrap
				      ? sub { shift->value->$m(
				              $self->_unwrap(@_)) }
				      : sub { shift->value->$m(@_) },
				);
			}
		}}
	}

	if(exists $opts{static_methods}) {
		my $methods = $opts{static_methods};
		if (ref $methods eq 'ARRAY') { for (@$methods) {
			my($m, $type) = _split_meth $_;
			$constructor->new_function(
				$m => defined $type
					? $unwrap
					  ? sub { $self->_cast(
					      scalar $pack->$m(
					        $self->_unwrap(@_)), $type
					  ) }
					  : sub { $self->_cast(
						scalar $pack->$m(@_), $type
					  ) }
					: $unwrap
					  ? sub { $pack->$m(
						$self->_unwrap(@_)) }
					  : sub { $pack->$m(@_) }
			);
			 # new_function makes the functions  enumerable,
			 # unlike new_method. This code is here to make
			 # things consistent. I'll delete it if someone
			 # convinces me otherwise. (I can't make
			 # up my mind.)
			$constructor->prop({
				name => $m, dontenum => 1
			});
		}} else { # it'd better be a hash!
		while( my($name, $m) = each %$methods) {
			if(ref $m eq 'CODE') {
				$constructor->new_function(
					$name => $unwrap
					? sub {
					    @_ = $self->_unwrap(@_);
					    unshift @_, $pack;
					    goto $m;
					}
					: sub {
					    unshift @_, $pack;
					    goto $m;
					}
				);
			} else {
				($m, my $type) = _split_meth $m;
				$constructor->new_function(
					$name => defined $type
						? sub { $self->_cast(
							scalar $pack->$m,
							$type
						) }
						: $unwrap
						  ? sub { $pack->$m(
						    $self->_unwrap(@_)) }
						  : sub { $pack->$m(@_) },
				);
			}
			 # new_function makes the functions  enumerable,
			 # unlike new_method. This code is here to make
			 # things consistent. I'll delete it if someone
			 # convinces me otherwise. (I can't make
			 # up my mind.)
			$constructor->prop({
				name => $name, dontenum => 1
			});
		}}
	}

	for(qw/to_primitive to_string to_number/) {
		exists $opts{$_} and $class{$_} = $opts{$_}
	}

	# The properties enumerated by the 'props' option need to be made
	# instance properties, since assignment never falls through to the
	# prototype,  and a fetch routine is passed the property's  actual
	# owner;  i.e., the prototype, if it is an inherited property.  So
	# we'll make a list of argument lists which &JE::Object::Proxy::new
	# will take care of passing to each object's prop method.
	{ my %props;
	if(exists $opts{props}) {
		my $props = $opts{props};
		$class{props} = \%props;
		if (ref $props eq 'ARRAY') {
		    for(@$props) {
			my ($p,$type) = _split_meth $_;
			$props{$p} = [
				fetch => defined $type
				  ? sub {
				    $self->_cast(
				      scalar $_[0]->value->$p, $type
				    )
				  }
				  : sub {
				    $self->upgrade(scalar $_[0]->value->$p)
				  },
				store => $unwrap
					? sub { $_[0]->value->$p(
						$self->_unwrap($_[1])) }
					: sub { $_[0]->value->$p($_[1]) },
			];
		    }
		} else { # it'd better be a hash!
		while( my($name, $p) = each %$props) {
			my @prop_args;
			if (ref $p eq 'HASH') {
				if(exists $$p{fetch}) {
				    my $fetch = $$p{fetch};
				    @prop_args = ( fetch =>
				        ref $fetch eq 'CODE'
				        ? sub { $self->upgrade(
				            scalar &$fetch($_[0]->value)
				        ) }
				        : do {
					  my($f,$t) = _split_meth $fetch;
					  defined $t ? sub { $self->_cast(
				            scalar shift->value->$f, $t
				          ) }
				          : sub { $self->upgrade(
				              scalar shift->value->$fetch
				          ) }
				        }
				    );
				}
				else { @prop_args =
					(value => $self->undefined);
				}
				if(exists $$p{store}) {
				    my $store = $$p{store};
				    push @prop_args, ( store =>
				        ref $store eq 'CODE'
				        ? $unwrap
					  ? sub {
				            &$store($_[0]->value,
				              $self->_unwrap($_[1]))
				          }
				          : sub {
				            &$store($_[0]->value, $_[1])
				          }
				        : $unwrap
				          ? sub {
				            $_[0]->value->$store(
				              $self->_unwrap($_[1]))
				          }
				          : sub {
				            $_[0]->value->$store($_[1])
				          }
				    );
				}
				else {
					push @prop_args, readonly => 1;
				}
			}
			else {
				if(ref $p eq 'CODE') {
					@prop_args = (
					    fetch => sub { $self->upgrade(
				                scalar &$p($_[0]->value)
				            ) },
					    store => $unwrap
					    ? sub {
				              &$p(
					        scalar $_[0]->value,
					        $self->_unwrap($_[1])
					      )
				            }
					    : sub {
				              &$p(
					        scalar $_[0]->value, $_[1]
					      )
				            },
					);
				}else{
					($p, my $t) = _split_meth($p);
					@prop_args = (
					    fetch => defined $t
					    ? sub { $self->_cast(
				                scalar $_[0]->value->$p, $t
				              ) }
					    : sub { $self->upgrade(
				                scalar $_[0]->value->$p
				              ) },
					    store => $unwrap
					    ? sub {
				                $_[0]->value->$p(
					          $self->_unwrap($_[1]))
				            }
					    : sub {
				                $_[0]->value->$p($_[1])
				            },
					);
				}
			}
			$props{$name} = \@prop_args;
		}}
	}
	if(defined $super){
		$class{props} ||= \%props;
		{
			my $super_props =
				$$$self{classes_by_name}{$super}{props}
				|| last;
			for (keys %$super_props) {
				exists $props{$_} or
					$props{$_} = $$super_props{$_}
			}
		}
	}}

	if(exists $opts{static_props}) {
		my $props = $opts{static_props};
		if (ref $props eq 'ARRAY') { for (@$props) {
			my($p,$t) = _split_meth $_;
			$constructor->prop({
				name => $p,
				fetch => defined $t
				  ? sub { $self->_cast(
				      scalar $pack->$p, $t
				    ) }
				  : sub { $self->upgrade(
				      scalar $pack->$p
				    ) },
				store => $unwrap
				  ? sub {$pack->$p($self->_unwrap($_[1]))}
				  : sub { $pack->$p($_[1]) },
			});
		}} else { # it'd better be a hash!
		while( my($name, $p) = each %$props) {
			my @prop_args;
			if (ref $p eq 'HASH') {
				if(exists $$p{fetch}) {
				    my $fetch = $$p{fetch};
				    @prop_args = ( fetch =>
				        ref $fetch eq 'CODE'
				        ? sub {
				            $self->upgrade(
					        scalar &$fetch($pack))
				        }
				        : do {
				            my($f,$t) = _split_meth $fetch;
				            defined $t ? sub {
				              $self->_cast(
				                scalar $pack->$f,$t)
				            }
				            : sub {
				              $self->upgrade(
				                scalar $pack->$f)
				            }
				        }
				    );
				}
				else { @prop_args =
					(value => $self->undefined);
				}
				if(exists $$p{store}) {
				    my $store = $$p{store};
				    push @prop_args, ( store =>
				        ref $store eq 'CODE'
				        ? $unwrap
				          ? sub {
				            &$store($pack,
				                    $self->_unwrap($_[1]))
				          }
				          : sub {
				            &$store($pack, $_[1])
				          }
				        : $unwrap
				          ? sub {
				            $pack->$store(
				                  $self->_unwrap($_[1]))
				          }
				          : sub {
				            $pack->$store($_[1])
				          }
				    );
				}
				else {
					push @prop_args, readonly => 1;
				}
			}
			else {
				if(ref $p eq 'CODE') {
					@prop_args = (
					    fetch => sub {
				                $self->upgrade(
					          scalar &$p($pack))
				            },
					    store => $unwrap
					    ? sub {
				                &$p($pack,
					            $self->_unwrap($_[1]))
				            }
					    : sub {
				                &$p($pack, $_[1])
				            },
					);
				} else {
					($p, my $t) = _split_meth $p;
					@prop_args = (
					    fetch => defined $t
					    ? sub {
				                $self->_cast(
					          scalar $pack->$p,$t)
				              }
					    : sub {
				                $self->upgrade(
					          scalar $pack->$p)
				              },
					    store => $unwrap
					    ? sub {
				                $pack->$p(
					          $self->_unwrap($_[1]))
				            }
					    : sub {
				                $pack->$p($_[1])
				            },
					);
				}
			}
			$constructor->prop({name => $name, @prop_args});
		}}
	}

	# ~~~ needs to be made more elaborate
# ~~~ for later:	exists $opts{keys} and $class{keys} = $$opts{keys};



	# $class{hash}{store} will be a coderef that returns true or false,
	# depending on whether it was able to write the property. With two-
	# way hash bindings, it will always return true

	if($opts{hash}) {
		if(!ref $opts{hash} # ) {
			#if(
			&& $opts{hash} =~ /^(?:1|(2))/) {
				$class{hash} = {
					fetch => sub { exists $_[0]{$_[1]}
						? $self->upgrade(
						    $_[0]{$_[1]})
						: undef
					},
					store => $1 # two-way?
					  ? sub { $_[0]{$_[1]}=$_[2]; 1 }
					  : sub {
						exists $_[0]{$_[1]} and
						   ($_[0]{$_[1]}=$_[2], 1)
					  },
				};
				$class{keys} ||= sub { keys %{$_[0]} };
			}
		else { croak
			"Invalid value for the 'hash' option: $opts{hash}";
		}

=begin comment

# I haven't yet figured out a logical way for this to work:

			else { # method name
				my $m = $opts{hash};
				$class{hash} = {
					fetch => sub {
						$self->_upgr_def(
						  $_[0]->value->$m($_[1])
						)
					},
					store => sub {
					  my $wrappee = shift->value;
					  defined $wrappee->$m($_[0]) &&
					    ($wrappee->$m(@_), 1)
					},
				};
			}
		} elsif (ref $opts{hash} eq 'CODE') {
			my $cref = $opts{hash};
			$class{hash} = {
				fetch => sub {
					$self->_upgr_def(
				            &$cref($_[0]->value, $_[1])
					)
				},
				store => sub {
				  my $wrappee = shift->value;
				  defined &$cref($wrappee, $_[0]) &&
				    (&$cref($wrappee, @_), 1)
				},
			};
		} else { # it'd better be a hash!
			my $opt = $opts{hash_elem};
			if(exists $$opt{fetch}) {
				my $fetch = $$opt{fetch};
				$class{hash}{fetch} =
				        ref $fetch eq 'CODE'
				        ? sub { $self-> _upgr_def(
				            &$fetch($_[0]->value, $_[1])
				        ) }
				        : sub { $self-> _upgr_def(
				            shift->value->$fetch(shift)
				        ) }
				;
			}
			if(exists $$opt{store}) {
				my $store = $$opt{store};
				$class{hash}{store} =
				        ref $store eq 'CODE'
				        ? sub {
				  	  my $wrappee = shift->value;
				  	  defined &$store($wrappee, $_[0])
					  and &$store($wrappee, @_), 1
				        }
				        : sub {
				  	  my $wrappee = shift->value;
				  	  defined $wrappee->$store($_[0])
					  and &$store($wrappee, @_), 1
				            $_[0]->value->$store(@_[1,2])
				        }
				;
			}
		}

=end comment

=cut

	}

	if($opts{array}) {
			if($opts{array} =~ /^(?:1|(2))/) {
				$class{array} = {
					fetch => sub { $_[1] < @{$_[0]}
						? $self->upgrade(
						    $_[0][$_[1]])
						: undef
					},
					store => $1 # two-way?
					  ? sub { $_[0][$_[1]]=$_[2]; 1 }
					  : sub {
						$_[1] < @{$_[0]} and
						   ($_[0]{$_[1]}=$_[2], 1)
					  },
				};
			}
		else { croak
		    "Invalid value for the 'array' option: $opts{array}";
		}

=begin comment

	} elsif (exists $opts{array_elem}) {
		if (!ref $opts{array_elem}) {
			my $m = $opts{array_elem};
			$class{array} = {
				fetch => sub {
					$self->upgrade(
						$_[0]->value->$m($_[1])
					)
				},
				store => sub { $_[0]->value->$m(@_[1,2]) },
			};
		} else { # it'd better be a hash!
			my $opt = $opts{array_elem};
			if(exists $$opt{fetch}) {
				my $fetch = $$opt{fetch};
				$class{array}{fetch} =
				        ref $fetch eq 'CODE'
				        ? sub { $self->upgrade(
				            &$fetch($_[0]->value, $_[1])
				        ) }
				        : sub { $self->upgrade(
				            shift->value->$fetch(shift)
				        ) }
				;
			}
			if(exists $$opt{store}) {
				my $store = $$opt{store};
				$class{array}{store} =
				        ref $store eq 'CODE'
				        ? sub {
				            &$store($_[0]->value, @_[1,2])
				        }
				        : sub {
				            $_[0]->value->$store(@_[1,2])
				        }
				;
			}
		}

=end comment

=cut

	}

	weaken $self; # we've got closures

	return # nothing
}

=over

=item $j->new_parser

This returns a parser object (see L) which allows you to
customise the way statements are parsed and executed (only partially
implemented).

=cut

sub new_parser {
	JE::Parser->new(shift);
}




=item $j->prototype_for( $class_name )

=item $j->prototype_for( $class_name, $new_val )

Mostly for internal use, this method is used to store/retrieve the
prototype objects used by JS's built-in data types. The class name should
be 'String', 'Number', etc., but you can actually store anything you like
in here. :-)

=cut

sub prototype_for {
	my $self = shift;
	my $class = shift;
	if(@_) {
		return $$$self{pf}{$class} = shift
	}
	else {
		return $$$self{pf}{$class} ||
		  ($self->prop($class) || return undef)->prop('prototype');
	}
}



=back

=cut



1;
__END__