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
|
package Atheme::Init;
=head1 init.pl -- perl initialisation for Atheme.
This file is processed on initialising the perl interpreter in C<perl.so>. It is
mainly concerned with setting up the Perl environment, maintaining the list of
loaded perl scripts, and providing the means to load and unload them.
=cut
use strict;
use warnings;
use FindBin;
use Symbol qw(delete_package);
use lib "$FindBin::Bin";
use Atheme;
use Atheme::Internal;
our %Scripts;
sub package_name_ify {
my ($filename) = @_;
$filename =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
# second pass only for words starting with a digit
$filename =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg;
# Dress it up as a real package name
$filename =~ s|/|::|g;
return "Embed" . $filename;
}
sub load_script {
my ($filename, $message, $nonfatal) = @_;
my $packagename = package_name_ify($filename);
if (defined $Scripts{$packagename})
{
if ($nonfatal) {
$message->reply("$filename is already loaded");
return;
}
# This will always be called with G_EVAL, so this die can be translated
# into a load error in the C module.
die "$filename is already loaded.";
}
local *FH;
open FH, $filename or die "Couldn't open $filename: $!";
local ($/) = undef;
my $script_text = <FH>;
close FH;
# Must all be on one line here to avoid messing up line numbers in error
# messages.
my $eval = "package $packagename; our %Info; $script_text";
{
my ($filename, $packagename, $script_text);
eval $eval;
}
if ($@) {
delete_package $packagename;
die $@;
}
$Scripts{$packagename} = $filename;
return $packagename;
}
sub unload_script {
my ($filename, $message) = @_;
my $packagename = package_name_ify($filename);
if (!defined $Scripts{$packagename})
{
die "$filename is not loaded";
}
eval "${packagename}::unload(\$message)";
Atheme::Internal::unbind_commands($packagename);
Atheme::Hooks::unbind_hooks($packagename);
delete_package($packagename);
delete $Scripts{$packagename};
}
sub list_scripts {
my ($si) = @_;
$si->success("Loaded scripts:");
my $num = 0;
foreach my $script (values %Scripts) {
$num++;
$si->success("$num: $script");
}
$si->success("\x02$num\x02 scripts loaded.");
}
sub call_wrapper {
my $sub = shift;
my $saved_alarm=$SIG{ALRM};
$SIG{ALRM} = sub { die "Script used too much running time"; };
my $ret;
eval {
alarm 1;
$ret = &$sub(@_);
};
alarm 0;
$SIG{ALRM} = $saved_alarm;
die $@ if $@;
return $ret;
}
|
