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
|
# A method is a snip of perl code that defines a subroutine. It has an
# owner that is a Programmer. The method can be run inside the Programmer's
# safe.
package Method;
use Error;
use ActiveUser;
use strict;
use Programmer;
use vars qw($AUTOLOAD);
use UNIVERSAL qw(isa);
# You can pass in a hash with keys of owner, code, and sub to set the
# properties of the method.
sub new {
my $proto=shift;
my $class = ref($proto) || $proto;
my $this = {};
if (@_) {
my %init=@_;
foreach (keys %init) {
$this->{$_}=$init{$_};
}
}
$this->{timestamp}=time();
bless($this, $class);
return $this;
}
# Run the method with the passed parameters.
sub run {
my $this=shift;
my $name=shift;
my $thing=$_[0];
if (! isa($this->{owner}, "Programmer")) {
return Error->new("Method owner is not a Programmer or doesn't exist.");
}
my @wasactive=ActiveUser::getactive();
ActiveUser::setactive($this->{owner});
# We need to run the method inside a subpackage of the safe -
# determine that package name here. What we do is we use the
# id number of the object that defines this method. *Not* necessarily
# the object that has called it. If that object has a parent that
# defines this method, we look there instead.
#
# TODO: well that's golden, except when we're being called
# from inside ->super(). Then this gets it wrong. Fix.
my $pkg="Thing".$thing->method_definer($name)->id;
# FIXME: ugly hack, using this global. Have to do this so
# the safe can see this function's parameters.
$main::params=\@_;
$main::method=$this->{'sub'};
$this->{owner}->compartment->share_from('main',[qw{$params $method}]);
my $code=$this->{code};
# FIXME: all this commented out stuff doesn't work because of some weird
# problem with defining subs insides safes. This means we can't do any method
# caching :-(
#
# # Check to see if the method has been cached, so we don't eval large
# # blocks of code each time a method is called..
# my $fullpkg=$this->{owner}->compartment->root."::$pkg";
# no strict 'refs';
# if (${$fullpkg."::timestamp"} >= $this->{timestamp} &&
# UNIVERSAL::can($fullpkg,$this->{'sub'})) {
# print "method $name in $fullpkg is cached\n";
# $code=undef;
# }
# ${$fullpkg."::timestamp"}=time();
# use strict 'refs';
#
# my @ret=$this->{owner}->compartment->reval("package $pkg;$code;".$this->{'sub'}.'(@$main::params)');
my @ret=$this->{owner}->compartment->reval("package $pkg;".'@ARGV=@$main::params;'.$code);
ActiveUser::setactive(@wasactive);
return @ret,$@;
}
# Invalidate the cache when the code in a method changes.
sub code {
my $this=shift;
if (@_) {
$this->{timestamp}=time();
return $this->{code}=shift;
}
return $this->{code};
}
# Invalidate the cache when the owner of a method changes.
sub owner {
my $this=shift;
if (@_) {
$this->{timestamp}=time();
return $this->{owner}=shift;
}
return $this->{owner};
}
sub AUTOLOAD {
my $this=shift;
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
if (@_) {
return $this->{$name} = shift;
}
else {
return $this->{$name};
}
}
1;
|
