line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#include "duk_module_node.h" |
2
|
|
|
|
|
|
|
#include "pl_module.h" |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
static duk_ret_t module_resolve(duk_context *ctx); |
5
|
|
|
|
|
|
|
static duk_ret_t module_load(duk_context *ctx); |
6
|
|
|
|
|
|
|
|
7
|
24
|
|
|
|
|
|
static duk_ret_t module_cb(duk_context *ctx, const char* func_name) |
8
|
|
|
|
|
|
|
{ |
9
|
24
|
|
|
|
|
|
SV* func = 0; |
10
|
24
|
50
|
|
|
|
|
if (!duk_get_global_string(ctx, func_name)) { |
11
|
|
|
|
|
|
|
/* TODO: maybe do something else here */ |
12
|
0
|
|
|
|
|
|
croak("%s is not a Perl handler\n", func_name); |
13
|
|
|
|
|
|
|
} |
14
|
24
|
50
|
|
|
|
|
if (!duk_is_c_function(ctx, -1)) { |
15
|
|
|
|
|
|
|
/* TODO: maybe do something else here */ |
16
|
0
|
|
|
|
|
|
croak("%s does not contain a C callback\n", func_name); |
17
|
|
|
|
|
|
|
} |
18
|
24
|
50
|
|
|
|
|
if (!duk_get_prop_lstring(ctx, -1, PL_SLOT_GENERIC_CALLBACK, sizeof(PL_SLOT_GENERIC_CALLBACK) - 1)) { |
19
|
0
|
|
|
|
|
|
croak("%s does not point to a Perl callback\n", func_name); |
20
|
|
|
|
|
|
|
} |
21
|
24
|
|
|
|
|
|
func = (SV*) duk_get_pointer(ctx, -1); |
22
|
24
|
|
|
|
|
|
duk_pop_2(ctx); /* pop pointer and function */ |
23
|
24
|
50
|
|
|
|
|
if (!func) { |
24
|
0
|
|
|
|
|
|
croak("%s points to a void Perl callback\n", func_name); |
25
|
|
|
|
|
|
|
} |
26
|
24
|
|
|
|
|
|
return pl_call_perl_sv(ctx, func); |
27
|
|
|
|
|
|
|
/* (void) duk_type_error(ctx, "cannot find module: %s", module_id); */ |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
15
|
|
|
|
|
|
static duk_ret_t module_resolve(duk_context *ctx) |
31
|
|
|
|
|
|
|
{ |
32
|
|
|
|
|
|
|
/* Entry stack: [ requested_id parent_id ] */ |
33
|
|
|
|
|
|
|
|
34
|
15
|
|
|
|
|
|
return module_cb(ctx, "perl_module_resolve"); |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
9
|
|
|
|
|
|
static duk_ret_t module_load(duk_context *ctx) |
38
|
|
|
|
|
|
|
{ |
39
|
|
|
|
|
|
|
/* Entry stack: [ module_id exports module ] */ |
40
|
|
|
|
|
|
|
|
41
|
9
|
|
|
|
|
|
return module_cb(ctx, "perl_module_load"); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
262
|
|
|
|
|
|
void pl_register_module_functions(Duk* duk) |
45
|
|
|
|
|
|
|
{ |
46
|
262
|
|
|
|
|
|
duk_context* ctx = duk->ctx; |
47
|
262
|
|
|
|
|
|
duk_push_object(ctx); |
48
|
262
|
|
|
|
|
|
duk_push_c_function(ctx, module_resolve, DUK_VARARGS); |
49
|
262
|
|
|
|
|
|
duk_put_prop_string(ctx, -2, "resolve"); |
50
|
262
|
|
|
|
|
|
duk_push_c_function(ctx, module_load, DUK_VARARGS); |
51
|
262
|
|
|
|
|
|
duk_put_prop_string(ctx, -2, "load"); |
52
|
262
|
|
|
|
|
|
duk_module_node_init(ctx); |
53
|
262
|
|
|
|
|
|
} |