Skip to content

Commit

Permalink
Merge pull request #19 from mamod/objects
Browse files Browse the repository at this point in the history
Objects
  • Loading branch information
mamod committed Apr 29, 2016
2 parents 522c154 + 3f571e7 commit 45e7d75
Show file tree
Hide file tree
Showing 4 changed files with 175 additions and 19 deletions.
41 changes: 41 additions & 0 deletions examples/buffer.pl
Original file line number Diff line number Diff line change
@@ -0,0 +1,41 @@
use lib './lib';
use strict;
use warnings;
use Data::Dumper;

use JavaScript::Duktape;

my $js = JavaScript::Duktape->new;

my $buffer = $js->get_object( q{
Buffer.prototype.get = function(n){
return this[n] || '';
};
Buffer.prototype.set = function set(n, v){
this[n] = v;
};
// will be implemented in perl
// var buf = new Buffer(7);
// buf.fill(97);
// print(buf.toString());
// var n = buf.slice(0, 2).fill('b');
// print(buf.toString());
Buffer;
});

my $buf = $buffer->new(7);

$buf->fill(97);
print $buf->byteLength, "\n"; #7
print $buf->toString('utf8'), "\n"; #aaaaaaa;

my $n = $buf->slice(0, 2)->fill('b');

print $n->byteLength, "\n"; #2
print $n->toString('utf8'), "\n"; #bb

print $n->get(1), "\n"; #98;
print $buf->get(6), "\n"; #97;
42 changes: 23 additions & 19 deletions lib/JavaScript/Duktape.pm
Original file line number Diff line number Diff line change
Expand Up @@ -136,7 +136,7 @@ sub new {
$duk->put_prop_string(-2, "PerlGlobalStash");
$duk->pop();

$THIS = bless { sub => 1, duk => $duk, heapptr => 0 }, "JavaScript::Duktape::Object";
$THIS = bless { duk => $duk, heapptr => 0 }, "JavaScript::Duktape::Object";

##global methods

Expand Down Expand Up @@ -742,15 +742,11 @@ package JavaScript::Duktape::Object; {
my $self = shift;
my $duk = $self->{duk};

#don't free if this coming from sub
return if $self->{sub};

##TODO: Move these to C
my $heapptr = delete $self->{heapptr};
return if (!$heapptr);
my $refcount = delete $self->{refcount};
return if (!$refcount);
$duk->push_global_stash();
$duk->get_prop_string(-1, "PerlGlobalStash");
$duk->push_number($heapptr);
$duk->push_number($refcount);
$duk->del_prop(-2);
$duk->pop_2();
}
Expand Down Expand Up @@ -819,9 +815,9 @@ package JavaScript::Duktape::Util; {
if (@_){
#called with special no arg _
shift if (ref $_[0] eq 'NOARGS');
$val = jsFunction($duk, $function_heap, $heapptr, 'call', @_);
$val = jsFunction($method, $duk, $function_heap, $heapptr, 'call', @_);
} else {
$val = jsFunction($duk, $function_heap, $heapptr);
$val = jsFunction($method, $duk, $function_heap, $heapptr);
}
} else {
$val = $duk->to_perl_object(-1);
Expand All @@ -834,6 +830,7 @@ package JavaScript::Duktape::Util; {
}

sub jsFunction {
my $methodname = shift;
my $duk = shift;
my $heapptr = shift;
my $constructor = shift || $heapptr;
Expand Down Expand Up @@ -898,33 +895,40 @@ package JavaScript::Duktape::Util; {
return bless $sub, "JavaScript::Duktape::Function";
}

my $REFCOUNT = 0;
sub jsObject {
my $options = shift;

my $duk = $options->{duk};
my $heapptr = $options->{heapptr};
my $constructor = $options->{constructor} || $heapptr;
##TODO: Move these to C
# to prevent duktape garbage collecting this object
# while it's still used in perl land we need to store
# it in perl global stash, this will be freed once the
# destroy method called of "JavaScript::Duktape::Object"

#We may push same heapptr on the global stack more
#than once, this results in segmentation fault when
#we destroy the object and delete heapptr from the
#global stash then trying to use it again
#TODO : this is really a poor man solution
#for this problem, we use a refcounter to create
#a unique id for each heapptr, a better solution
#would be making sure same heapptr pushed once and not to
#be free unless all gone
my $refcount = (++$REFCOUNT) + (rand(3));

$duk->push_global_stash();
$duk->get_prop_string(-1, "PerlGlobalStash");
$duk->push_number($heapptr);
$duk->push_number($refcount);
$duk->push_heapptr($heapptr);
$duk->put_prop(-3); #PerlGlobalStash[heapptr] = object
$duk->pop_2();

my $type = $duk->get_type(-1);

##if this is a function return sub immediately
##other wise return blessed package
if ($duk->is_function(-1)){
return JavaScript::Duktape::Util::jsFunction($duk, $heapptr, $constructor);
return JavaScript::Duktape::Util::jsFunction('anon', $duk, $heapptr, $constructor);
}

return bless {
refcount => $refcount,
duk => $duk,
heapptr => $heapptr
}, "JavaScript::Duktape::Object";
Expand Down
54 changes: 54 additions & 0 deletions t/objects/buffer.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,54 @@
use lib './lib';
use strict;
use warnings;
use utf8;
use Encode;
use Data::Dumper;
use Test::More;
use JavaScript::Duktape;

my $js = JavaScript::Duktape->new;
my $duk = $js->duk;
my $ret = $duk->eval_string( q{
Buffer.prototype.get = function(n){
return this[n];
};
Buffer.prototype.set = function set(n, v){
this[n] = v;
};
Buffer;
});

my $buffer = $duk->to_perl_object(-1);
$duk->pop();

for (0 .. 10){
is $duk->get_top(), 0;
my $gg = $buffer->new(7);

$gg->fill('V');
$gg->fill('V');
my $t = $buffer->new(17);
$t->fill("3");

is $t->toString('utf8'), Encode::encode('UTF-8', ("\3" x 17) );
is $t->byteLength, 17;

# $t->setx(0, 66);
# #
is $t->get(0), 3;
$t->set(1, 97);
is $t->get(1), 97;

my $n = $t->slice(0, 2)->fill('b');
$n->fill('a');

is $n->byteLength, 2;
is $n->toString('utf8'), 'aa';

is $gg->toString('utf8'), "V" x 7;
is $gg->byteLength, 7;
}

is $duk->get_top(), 0;
done_testing(100);
57 changes: 57 additions & 0 deletions t/objects/string.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,57 @@
use lib './lib';
use strict;
use warnings;
use Data::Dumper;
use JavaScript::Duktape;
use Test::More;

my $js = JavaScript::Duktape->new;
my $duk = $js->duk;
my $ret = $duk->eval_string( q{
String;
});

my $string = $duk->to_perl_object(-1);
$duk->pop();

my $str = $string->new("Hi there");
my $str2 = $str->slice(0, 2);
is $str2, 'Hi';

is $str->charAt(10000), '';
is $str->charAt(0), 'H';

is $str->toUpperCase(_), 'HI THERE';
is $str->slice(3, $str->length), 'there';



is $string->new('Blue Whale')->indexOf('Blue'), 0; #// returns 0
is $string->new('Blue Whale')->indexOf('Blute'), -1; #// returns -1
is $string->new('Blue Whale')->indexOf('Whale', 0), 5; #// returns 5
is $string->new('Blue Whale')->indexOf('Whale', 5), 5; #// returns 5
is $string->new('Blue Whale')->indexOf('', 9), 9; #// returns 9
is $string->new('Blue Whale')->indexOf('', 10), 10; #// returns 10
is $string->new('Blue Whale')->indexOf('', 11), 10; #// returns 10


{
my $str = $string->new('To be, or not to be, that is the question.');
my $count = 0;
my $pos = $str->indexOf('e');

while ($pos != -1) {
$count++;
$pos = $str->indexOf('e', $pos + 1);
}
is $count, 4; #// displays 4
is $str->concat->(' EOF'), 'To be, or not to be, that is the question. EOF';
}


my $orig = $string->new(' foo ');
is $orig->trim(_), 'foo'; #// 'foo'

is $duk->get_top(), 0;

done_testing(16);

0 comments on commit 45e7d75

Please sign in to comment.