| Subject: | Silent JS crash changing a key in a TIED hash |
| Date: | Wed, 01 Feb 2012 15:00:18 -0800 |
| To: | bug-JSPL [...] rt.cpan.org |
| From: | robb <robb [...] canfield.com> |
Thanks for coding JSPL, I was using JavaScript::MonkeyScript but it
lacked a reliable way to alter data. JSPL allows a lot more flexibility.
Unfortunately I am encountering a problem.
The following code tests some assumptions I have about JSPL. Everything
works until the end of the JS code. When I try to change a TIED Perl
HASH the JS exits. An exception is not thrown. A normal HASH can be
modified easily.
Is there something I am doing wrong?
# Example of silent JS crash setting a TIED variable
use JSPL;
use strict;
my $ctx = JSPL::Runtime->new->create_context();
$ctx->bind_function(
out => sub {print @_, "\n";},
);
$ctx->bind_function(
array_test => sub {return [qw/a b c d/];}
);
$ctx->bind_function(
hash_test => sub {return {'a' => 'A', 'b' => 'B', 'c' => {'c1' =>
'C1', 'c2' => 'C2'}};}
);
my %Data;
tie(%Data, 'Data::Hash', {'Name' => 'Robb', 'Address' => 'this is
address', 'State' => 'this is state'});
use Data::Dumper;
warn(Dumper(\%Data));
$ctx->bind_value('Data.Query' => \%Data);
my $result = $ctx->eval(<<'{END}');
// Core Array Works
var a = array_test();
out(a[2]);
a[2] = 'Changed array a[2]';
out(a[2]);
// Core HASH works
var b = hash_test();
out(b.a);
var i;
for (i in b.c) {
out(i + " : " + b.c[i]);
}
b.b = 'Changed hash b.b';
out(b.b);
// Reading tied hash works
out(Data.Query.Name);
// ******* Writing tied hash FAILS silently at the set
Data.Query.Name = 'Robb^Canfield';
out(Data.Query.Name);
{END}
warn(Dumper($result));
# Test of tie package for Data HASH
package Data::Hash;
use Storable qw/dclone/;
our @ISA = 'Tie::StdHash';
sub TIEHASH {
my $class = shift;
my(
$data,
$ro,
) = @_;
my $self = {
'ro' => $ro || 0,
'data' => dclone($data),
};
if (0 && ! $ro) {
$self->{'original'} => {};
tie(%{$self->{'original'}}, __PACKAGE__, dclone($data), 1);
}
return bless $self, $class;
}
sub STORE {
print STDERR "STORE\n";
my $self = shift;
my(
$key,
$value,
) = @_;
if (! $self->{'ro'}) {
$self->{'data'}{$key} = $value;
}
return $self->{'data'}{$key};
}
sub FETCH {
print STDERR "FETCH\n";
my $self = shift;
my(
$key,
) = @_;
return $self->{'data'}{$key};
}
# DELETE is NOT supported! Removing data elements is not currently
supported as its a bit of a pain to deal with what can and cannot be removed
sub DELETE {
my $self = shift;
my(
$key,
) = @_;
}
# CLEAR is NOT supported! See DELETE for why
sub CLEAR {
my $self = shift;
}
sub EXISTS {
print STDERR "EXISTS\n";
my $self = shift;
my(
$key,
) = @_;
return exists $self->{'data'}{$key};
}
sub FIRSTKEY {
print STDERR "FIRSTKEY\n";
my $self = shift;
# Use native Perl HASH tracking on the data hash
my $a = keys %{$self->{'data'}}; # reset internal each() iterator
return each %{$self->{'data'}};
}
sub NEXTKEY {
print STDERR "NEXTKEY\n";
my $self = shift;
return each %{$self->{'data'}};
}
sub SCALAR {
print STDERR "SCALAR\n";
my $self = shift;
return scalar(%{$self->{'data'}});
}