1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
############################################################################
# PerlConnect support package. 8/3/98 2:50PM
# This packages implements private methods called from jsperl.c
# Please don't try to include in from Perl
# See README.html and JS.xs for information about this module.
############################################################################
package JS;
require Exporter;
require DynaLoader;
@ISA = qw(Exporter DynaLoader);
@EXPORT_OK = qw(perl_eval perl_resolve perl_call $js $ver);
# version string for the interpreter
$ver = "[Perl Interpreter: Version $] compiled under $^O]\n";
$DEBUG = undef;
############################################################################
# TODO: This will be added
############################################################################
sub AUTOLOAD #7/28/98 8:24PM
{
print "\nJS::AUTOLOAD: $AUTOLOAD, not implemented yet\n" if $DEBUG;
} ##AUTOLOAD
############################################################################
# Evaluates the parameter and returns the return result of eval() as a
# reference
############################################################################
sub perl_eval #7/15/98 5:13PM
{
my($stmt) = shift;
package main;
my(@_js) = eval($stmt);
package JS;
my($_js) = (scalar(@_js)==1)?$_js[0]:\@_js;
undef $js;
$js = (ref $_js) ? $_js: \$_js;
print "Failure in perl_call!" unless ref $js;
} ##perl_eval
############################################################################
# Calls the procesure passed as the first parameter and passes the rest of
# the arguments to it. The return result is converted to a reference as
# before
############################################################################
sub perl_call #7/21/98 2:16PM
{
my($proc) = shift;
my($_js);
$proc =~ s/main:://g;
#print "Calling $proc\n";
package main;
my(@_js) = &$proc(@_);
package JS;
#print "here: ", @_js, "\n";
$_js = (scalar(@_js)==1)?$_js[0]:\@_js;
undef $js;
$js = (ref $_js) ? $_js: \$_js;
#print ref $js;
print "Failure in perl_call!" unless ref $js;
} ##perl_call
############################################################################
# Takes the first parameter and tries to retrieve this variable
############################################################################
sub perl_resolve #7/22/98 10:08AM
{
my($name) = shift;
my(@parts) = split('::', $name);
my($last_part) = pop(@parts);
# variable lookup -- variables must start with $, @, or %
if($last_part =~ /^([\$\@\%])(.+)/){
my($resolved_name) = "$1".join('::', @parts)."::$2";
package main;
my(@_js) = eval($resolved_name);
package JS;
my($_js) = (scalar(@_js)==1)?$_js[0]:\@_js;
undef $js;
$js = (ref $_js) ? $_js: \$_js;
}else{
$name =~ s/main:://g;
# if this function exists
# function -- set $js to 1 to indicate this
if(eval "return defined(&main::$name)"){
print "function $name\n" if $DEBUG;
$js = 1;
# module
}else{
print "must be a module\n" if $DEBUG;
$js=2;
return;
# defined module -- try to do an eval and check $@ to trap errors
# as a result, the module is automatically pre-use'd if it exists
$name =~ s/main:://g;
if(eval "use $name; return !(defined($@));"){
$js = 2;
# o.w. this module is undefined
}else{
$js = 3;
}
}
}
} ##perl_resolve
############################################################################
# Validates package name
############################################################################
sub perl_validate_package #7/22/98 10:15AM
{
print "perl_validate_package\n" if $DEBUG;
my($name) = shift;
print $name if $DEBUG;
$js = $name?1:undef;
} ##perl_validate_package
# test procedure
sub c{
print "da!\n" if wantarray;
print "Called!\n";
return @_;
}
1;
|
