package JavaScript::Shell;
use strict;
use warnings;
use utf8;
use FindBin qw($Bin);
use File::Spec;
use Carp;
use JSON::XS;
use IPC::Open2;
our $VERSION = '0.02';
#===============================================================================
# Global Methods
#===============================================================================
my $MethodsCounter = 0;
my $METHODS = {
    ##pre defined methods
    __stopLoop => \&stop,
    _deleteTempFile => sub {
        shift;
        my $args = shift;
        unlink $args;
    }
};

#===============================================================================
# stop
#===============================================================================
sub stop {
    my $self = shift;
    my $args = shift;
    $self->{_return_value} = $args;
    $self->{running} = 0;
}

sub new {
    my $class = shift;
    my $opt = shift;
    
    if ($opt->{onError} && ref $opt->{onError} ne 'CODE'){
        croak "onError options accepts a code ref only";
    } else {
        $opt->{onError} = sub {
            my $js = shift;
            my $error = shift;
            #$js->destroy();
            
            print STDERR $error->{type}
            . ' : '
            . $error->{message}
            . ' at '
            . $error->{file}
            . ' line ' . $error->{line} . "\n";
            exit(1);
        }
    }
    
    ( my $path = $INC{'JavaScript/Shell.pm'} ) =~ s/\.pm$//;
    
    my $js = "$path/bin/js";
    $js = File::Spec->canonpath( $js );
    
    local $ENV{LD_LIBRARY_PATH} = "$path/bin";
    
    my $self = bless({
        running => 0,
        _path => $path,
        _json => JSON::XS->new,
        _ErrorHandle => $opt->{onError},
        _js => $js,
        pid => $$
    },$class);
    
    $self->_run();
    return $self;
}

#===============================================================================
# createContext
#===============================================================================
sub createContext {
    my $self = shift;
    my $sandbox = shift;
    if (defined $sandbox && ref $sandbox ne 'HASH'){
        croak "createContext accepts HASH Ref Only";
    }
    return JavaScript::Shell::Context->new($self,$sandbox);
}

#===============================================================================
# helpers
#===============================================================================
sub path        {   shift->{_path}                  }
sub json        {   shift->{_json}                  }
sub toJson      {   shift->{_json}->encode(@_)   }
sub toObject    {   shift->{_json}->decode(@_)   }
sub context     {   shift->{context}                }
sub watcher     {   shift->{FROM_JSHELL}            }

#===============================================================================
# IPC - listen
#===============================================================================
sub isRunning { shift->{running} == 1 }

sub _run {
    my $self = shift;
    my $file = shift;
    
    my @cmd = ($self->{_js},'-f', $self->{_path} . '/builtin.js');
    my $pid = open2($self->{FROM_JSHELL},$self->{TO_JSHELL}, @cmd);
    $self->{jshell_pid} = $pid;
    
    binmode $self->{TO_JSHELL},":utf8";
    binmode $self->{FROM_JSHELL},":crlf :utf8";
    
    ## set error handler
    $self->Set('jshell.onError' => sub {
        my $js = shift;
        my $args = shift;
        $self->{_ErrorHandle}->($js,$args->[0]);
    });
    
    return $self;
}
#===============================================================================
# Running Loop
#===============================================================================
sub run {
    my $self = shift;
    my $once = shift;
    
    return if $self->isRunning;
    $self->{running} = 1;
    
    if ($once){
        $self->call('jshell.endLoop');
    }
    
    my $WATCHER = $self->watcher;
    
    while(my $catch = <$WATCHER>){
        $self->processData($catch);
        last if !$self->isRunning;
    }
    return $self;
}

#===============================================================================
# run once is run twice actually - the second one to make sure there is no
# actions left
#===============================================================================
sub run_once {
    my $self = shift;
    $self->run(1);
    $self->run(1);
    return $self;
}

#===============================================================================
# handle errors
#===============================================================================
sub onError {
    my $self = shift;
    my $handle = shift;
    
    if (ref $handle ne 'CODE'){
        croak "onError method requires a code ref";
    }
    
    $self->{_ErrorHandle} = $handle;
    return $self;
}


#===============================================================================
# send code to shell
#===============================================================================
sub send {
    my $ret = {};
    my $self = shift;
    local $ret->{code} = shift;
    my $to = $self->{TO_JSHELL};
    print $to ($ret->{code} . "\n");
}

#===============================================================================
# set variable/object/function
#===============================================================================
sub Set {
    my $self = shift;
    my $name = shift;
    my $value = shift;
    my $options = shift;
    my $ref = ref $value;
    if ($ref eq 'CODE'){
        $MethodsCounter++;
        $METHODS->{$MethodsCounter} = $value;
        $self->call('jshell.setFunction',$name,$MethodsCounter,$self->{context},$options);
    } else {
        $self->call('jshell.Set',$name,$value,$self->context);
    }
    return $self;
}

#===============================================================================
# get values
#===============================================================================
sub get {
    my $self = shift;
    my $value = shift;
    my $val = JavaScript::Shell::Result->new();
    $METHODS->{setValue} = sub {
        my $self = shift;
        my $args = shift;
        $val->add($args);
        return 1;
    };
    $self->call('jshell.getValue',$value,$self->context,@_);
    $self->run_once();
    return $val;
}


#==============================================================================
# Call Javascript Function
#==============================================================================
sub call {
    my $self = shift;
    my $fun = shift;
    my $args = \@_;
    my $send = {
        fn => $fun,
        args => $args,
        context => $self->context
    };
    
    $send = $self->toJson($send);
    $self->send('jshell.execFunc(' . $send . ')');
    $self->run_once();
}

#==============================================================================
# eval Script string
#==============================================================================
sub load {
    my $self = shift;
    my $file = shift;
    $file = File::Spec->canonpath( $file ) ;
    $file =~ s/\\/\\\\/g;
    $self->call('load' => $file);
}

sub eval {
    my $self = shift;
    my $code = shift;
    $self->call('jshell.evalCode',$code,$self->context);
    
}

sub datavar {
    my $self = shift;
    $self->{buffer} = \$_[0];
}

#===============================================================================
#  Process data from & to js shell
#===============================================================================
sub processData {
    my $self = shift;
    my $obj = $_[0];
    
    #convert recieved data from json to perl hash
    #then translate and process
    my $hash = {};
    my $ret = {};
    
    eval {
        $hash = $self->toObject($obj);
    };
    
    ##
    if ($@){
        
        #read until we get end of buffer;
        my $w = $self->watcher;
        
        $self->{buffer} = $obj;
        $self->{buffer} .= do {
            local $/ = "defdba7883bd47f7a043e0c9680d8b13";
            <$w>;
        };
        
        use bytes;
        my $len = bytes::length($self->{buffer}) - 33;
        $self->{buffer} = unpack "a$len", $self->{buffer};
        no bytes;
        return;
    }
    
    my $callMethod;
    
    local $ret->{args};
    if (my $method = $hash->{method}){
        if (my $sub = $METHODS->{$method}) {
            $callMethod = sub { $self->$sub(shift,shift) };
        } else {
            croak "can't locate method $method";
        }
        
        $ret->{args} = $callMethod->($hash->{args},$hash);
    }
    
    $self->{buffer} = '';
    if (ref $ret->{args} eq 'JavaScript::Shell::Buffer'){
        $hash->{_buffer} = $ret->{args}->{buff};
    } else {
        $hash->{_args} = $ret->{args};
    }
    
    $ret->{args} = $self->toJson($hash);
    $self->send("jshell.setArgs($ret->{args})");
    undef $ret;
    return 1;
}

sub buffer {
    my $self = shift;
    my $ret = {};
    $ret->{args} = shift;
    my $encoding = shift;
    return JavaScript::Shell::Buffer->new($ret->{args},$encoding);
}

sub getBuffer {
    my $self = shift;
    my $ret = {};
    local $ret->{ret} = $self->{buffer};
    ##buffer will get empty once consumed
    undef $self->{buffer};
    return $ret->{ret};
}

#===============================================================================
# destroy
#===============================================================================
sub destroy {
    my $self = shift;
    $self->call('quit');
}

sub DESTROY {
    my $self = shift;
    kill -9,$self->{jshell_pid} if $$ > 0;
}

#===============================================================================
# JavaScript::Shell::Result
#===============================================================================
package JavaScript::Shell::Result;

sub new {
    my $class = shift;
    return bless([],$class);
}

sub add {
    my $self = shift;
    my $values = shift;
    $self->[0] = $values;
}

sub value {
    my $self = shift;
    my $i = shift;
    return $i ? $self->[0]->[$i] : $self->[0];
}

#===============================================================================
# JavaScript::Shell::Context
#===============================================================================
package JavaScript::Shell::Context;
use base 'JavaScript::Shell';
no warnings 'redefine';
my $CONTEXT = 0;

sub new {
    my $class = shift;
    my $js = shift;
    my $sandbox = shift;
    $CONTEXT++;
    
    $js->call('jshell.setContext',$CONTEXT,$sandbox);
    
    my $args = {};
    
    %{$args} = %{$js};
    my $self = bless($args,$class);
    $self->{context} = $CONTEXT;
    return $self;
}


package JavaScript::Shell::Buffer;
use File::Temp qw/ tempfile tempdir /;

my $RET = {};
sub new {
    my $class = shift;
    local $RET->{str} = shift;
    my $encoding = shift || 'none';
    
    #create new temp file
    my ($fh, $filename) = tempfile();
    binmode $fh,":encoding(utf-8)";
    print $fh $RET->{str};
    close $fh;
    
    undef $RET->{str};
    return bless({
        buff => $filename
    },$class);
}

1;

=pod

=head1 NAME

JavaScript::Shell - Run Spidermonkey shell from Perl

=head1 SYNOPSIS

    use JavaScript::Shell;
    use strict;
    use warnings;
    
    my $js = JavaScript::Shell->new();
    
    ##create context
    my $ctx = $js->createContext();
    
    $ctx->Set('str' => 'Hello');
    
    $ctx->Set('getName' => sub {
        my $context = shift;
        my $args    = shift;
        my $firstname = $args->[0];
        my $lastname  = $args->[1];
        return $firstname . ' ' . $lastname;
    });
    
    $ctx->eval(qq!
        function message (){
            var name = getName.apply(this,arguments);
            var welcome_message = str;
            return welcome_message + ' ' + name;
        }
    !);
    
    
    my $val = $ctx->get('message' => 'Mamod', 'Mehyar')->value;
    
    print $val . "\n"; ## prints 'Hello Mamod Mehyar'
    
    $js->destroy();

=head1 DESCRIPTION

JavaScript::Shell will turn Spidermonkey shell to an interactive environment
by connecting it to perl

With JavaScript::Shell you can bind functions from perl and call them from
javascript or create functions in javascript then call them from perl

=head1 WHY

While I was working on a project where I needed to connect perl with javascript
I had a lot of problems with existing javascript modules, they were eaither hard
to compile or out of date, so I thought of this approach as an alternative.

Even though this sounds crazy to do, to my surprise it worked as expected - at
least in my usgae cases

=head1 SPEED

JavaScript::Shell connect spidermonkey with perl through IPC bridge using
L<IPC::Open2> so execution speed will never be as fast as using C/C++
bindings ported to perl directly

There is another over head when translating data types to/from perl, since it
converts perl data to JSON & javascript JSON to perl data back again.

Saying that, the over all speed is acceptable and you can take some steps to
improve speed like

=over 4

=item Data Transfer

Try to transfer small data chunks between processes when possible, sending
large data will be very slow

=item Buffer Data

As of version 0.02 JavaScript::shell has a new method for dealing with large
strings passed to/from javascript, use this feature when ever you want to send
large data "strings" -- see C<buffer>

=item Minimize calls

Minimize number of calls to both ends, let each part do it's processing.
for eaxmple:

    ##instead of
    
    $js->eval(qq!
        function East (){}
        function West (){}
        function North (){}
        function South (){}
    !);
    
    $js->call('East');
    $js->call('West');
    $js->call('North');
    $js->call('South');
    
    ##do this
    
    $js->eval(qq!
        function all () {
            
            East();
            West();
            North();
            South();
            
        }
        
        function East (){}
        function west (){}
        function North (){}
        function South (){}
        
    !);
    
    $js->call('all');

=back


=head1 CONTEXT

Once you intiate JavaScript::Shell you can create as many contexts
as you want, each context will has it's own scope and will not overlap
with other created contexts.

    my $js = JavaScript::Shell->new();
    my $ctx = $js->createContext();

You can pass a hash ref with simple data to C<createContext> method as a
sandbox object and will be copied to the context immediately

    my $ctx->createContext({
        Foo => 'Bar',
        Foo2 => 'Bar2'
    });

=head1 FUNCTIONS

=head2 new

Initiates SpiderMonkey Shell

=head2 createContext

creates a new context

=head2 run

This will run javascript code in a blocking loop until you call jshell.endLoop()
from your javascript code

    $js->Set('Name' => 'XXX');
    $js->eval(qq!
        for (var i = 0; i < 100; i++){
            
        }
        
        jshell.endLoop();
        
    !);
    
    $js->run();
    
    ##will never reach this point unless we call
    ## jshell.endLoop(); in javascript code as above
    

=head2 Set

Sets/Defines javascript variables, objects and functions from perl
    
    ## set variable 'str' with Hello vales
    $ctx->Set('str' => 'Hello');
    
    ## set 'arr' Array Object [1,2,3,4]
    $ctx->Set('arr' => [1,2,3,4]);
    
    ## set Associated Array Object
    $ctx->Set('obj' => {
        str1 => 'something',
        str2 => 'something ..'
    });
    
    ## set 'test' function
    ## caller will pass 2 arguments
    ## 1- context object
    ## 2- array ref of all passed arguments
    $ctx->Set('test' => sub {
        my $context = shift;
        my $args = shift;
        
        return $args->[0] . ' ' . $args->[1];
    });
    
    ## javascript object creation style
    
    $ctx->Set('obj' => {});
    
    #then
    $ctx->Set('obj.name' => 'XXX');
    $ctx->Set('obj.get' => sub { });
    ...

=head2 get

get values from javascript code, returns a C<JavaScript::Shell::Value> Object
    
    my $ret = $ctx->get('str');
    print $ret->value; ## Hello
    
    ## remember to call value to get the returned string/object
    
get method will search your context for a matched variable/object/function and
return it's value, if the name was detected for a function it will run this
function first and then returns it's return value
    
    $ctx->get('obj.name')->value; ## XXX
    
    ##you can pass variables when trying to get a function
    $ctx->get('test' => 'Hi','Bye')->value; ## Hi Bye
    
    ##get an evaled script values
    
    $ctx->get('eval' => qq!
        var n = 2;
        var x = 3;
        n+x;
    !)->value;  #--> 5
    
    
=head2 call

Calling javascript functions from perl, same as C<get> but doesn't return any
value

    $ctx->call('test');

=head2 eval

eval javascript code

    $ctx->eval(qq!
        
        //javascript code
        var n = 10;
        for(var i = 0; i<100; i++){
            n += 10;
        }
        ...
    !);
    
=head2 buffer

This function should be used only when dealing with passing large strings

    $js->Set('largeStr' => sub{
        
        my $js = shift;
        my $args = shift;
        
        ##we have a very large string we need to pass to
        ##javascript
        
        return $js->buffer('large string');
        
    });
    
    
    ##javascript
    var str = largeStr();
    

The same thing can be done when sending large strings from javascript to perl

    //javascript
    
    var str = 'very large string we need to pass to perl';
    jshell.sendBuffer(str);
    
    ##perl
    ##to consume this string from perl just get it
    my $str = $js->getBuffer();    
    
=head2 onError

set error handler method, this method accepts a code ref only. When an error
raised from javascript this code ref will be called with 2 arguments

=over 4

=item * JavaScript::Shell instance

=item * error object - Hash ref

=back

Error Hash has the folloing keys

=over 4

=item * B<message>  I<error message>

=item * B<type>     I<javascript error type: Error, TypeError, ReferenceError ..>

=item * B<file>     I<file name wich raised this error>

=item * B<line>     I<line number>

=item * B<stack>    I<string of the full stack trace>

=back

Setting error hnadler example

    my $js = JavaScript::Shell->new();
    $js->onError(sub{
        my $self = shift;
        my $error = shift;
        print STDERR $error->{message} . ' at ' . $error->{line}
        exit(0);
    });

=head2 destroy

Destroy javascript shell / clear context

    my $js = JavaScript::Shell->new();
    my $ctx->createContext();
    
    ##clear context;
    $ctx->destroy();
    
    ##close spidermonkey shell
    $js->destroy();

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.16.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 COPYRIGHTS

Copyright (C) 2013 by Mamod A. Mehyar <mamod.mehyar@gmail.com>

=cut

