The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

package Foo;

use Test::More tests => 11;

use strict;
use warnings;

use JavaScript;

sub new {
    return bless {}, __PACKAGE__;
}

sub bar { 
    return bless { std => 5 }, __PACKAGE__;
}

sub baz {
    my $self = shift; 
    return "five"; 
}

sub getWrap {
    my ($self) = @_;
    $self->{"getter_called"} = 1;
    $self->{"wrapped"};
}

sub setWrap {
    my ($self,$value) = @_;
    $self->{"setter_called"} = 1;
    $self->{"wrapped"} = $value;
}

my $rt1 = JavaScript::Runtime->new();
my $cx1 = $rt1->create_context();

$cx1->bind_class(
                 name => 'Foo',
                 constructor => sub { return new Foo(); },
                 methods => {
                             bar => \&Foo::bar,
                             baz => \&Foo::baz,
                         },
                 properties => {
                                std => 0,
                                wrapped_value => {
                                                  flags => JS_PROP_ACCESSOR,
                                                  setter => Foo->can('setWrap'),
                                                  getter => Foo->can('getWrap'),
                                              },  
                            },
                 package => 'Foo'
             );

my $foo = Foo->new();
$foo->{std} = 10;

$cx1->bind_function(println => sub { print STDERR @_, "\n"; });
$cx1->bind_function( name => 'debug',
             func => sub { warn Dumper(@_) } );
$cx1->bind_function( name => 'isa_ok',
             func => sub { isa_ok($_[0], $_[1]) } );
$cx1->bind_function( name => 'is',
             func => \&is );
$cx1->bind_function( name => 'get_foo',
             func => sub { bless { std => 5}, 'Foo' } );

$cx1->bind_object('FooSan', $foo);

my $ret= $cx1->eval(q!
is(FooSan.std, 10);
isa_ok(FooSan, "Foo");
a = get_foo();
is(a.std, 5);

isa_ok(a, "Foo");

b = new Foo;
isa_ok(FooSan, "Foo");
isa_ok(b, "Foo");
var obj = { key1: 'ok', key2: 'ok' };

a;
!);
isa_ok($ret, 'Foo');



# throw an instance of a perl class bound into JS space _through_ js
# space. Make sure that (a) the instance in JS space looks like the
# thing we threw, and (b) that the instance that leaves is _still_
# the thing we threw.

# the thing we throw.
my $thing = bless { std => 5, wrapped => 4 }, 'Foo';

# a function to throw it.
$cx1->bind_function( name => 'throw_foo', func => sub { die $thing });

my $error = $cx1->eval(q!
var ret; // to return the object from JS space

try {
  throw_foo();
} catch (e) {
  println("Here");
  isa_ok( e, "Foo" ); // this test passes, but if run, breaks the next test
  is( e.std, 5, "std is correct" );
  is( e.wrapped_value, 4, "wrapped is correct" );
  ret = e;
}
ret;
!);

is( $error->{std}, 5, "error _leaves_ JS space ok");