On Thu, 9 Dec 2004, Bakken, Luke wrote:
> Or modules for that matter. When I first read the eval trickery my first
> thought was "WHY???".
Well, I have a set of script files. Each file is split into an init
section and several different scripts. The init section is eval'd right
away and each script section is eval'd when needed.
The reason I went this way was to make these script files as simple as
possible and, more importantly, so that I can reload them as many times
as I want without having to exit the program.
When a warning happens in the script file below, it works fine because I
know which file, script, and section is being executed. So
handle_warn() can properly display the error.
But if another script file defines a function in its INIT section, and
this script calls that function, I still think the warning came from
this file. The only way I see around this is to see that this file was
(eval 12) and the other file was (eval 10) so when I see (eval 10) in
the warning I can know that the line number refers to the other file.
Here is an example script file:
--------------------------------------------------------------------
# SECTION(INIT)
script_name 'Bookmarks';
script_version '0.1';
script_desc 'Scripts to add and remove bookmarks';
###############################################################################
# USER SCRIPT(add_bookmark): Adds a new bookmark
# SECTION(INFO)
argument 'sector', required => 1, prompt => 'Bookmark which sector?',
type => 'integer', min => 1,
max => sub {return $game_data{'game_settings'}{'max_sectors'}},
default => sub {return $game_data{'user'}{'curr_sector'}};
argument 'name', required => 1, prompt => 'Name the bookmark', type => 'string';
# SECTION(CODE)
if ($name =~ /^\d+$/) {
print_text($RED . "ERROR: Bookmark name must not contain only numbers!\n" .
$WHITE);
} else {
if (exists $game_data{'bookmarks'}{$name}) {
print_text($RED . "ERROR: Bookmark '$name' already exists!\n" . $WHITE);
} else {
$game_data{'bookmarks'}{$name} = $sector;
print_text($GREEN . "Bookmark $name => $sector added.\n" . $WHITE);
}
}
###############################################################################
# USER SCRIPT(remove_bookmark): Removes a bookmark
# SECTION(INFO)
argument 'name', required => 1, prompt => 'Remove which bookmark', type =>
'string', complete => sub {
my @ret;
if (exists $game_data{'bookmarks'}) {
@ret = (keys %{$game_data{'bookmarks'}});
}
return [EMAIL PROTECTED];
};
# SECTION(CODE)
if (exists $game_data{'bookmarks'}{$name}) {
delete $game_data{'bookmarks'}{$name};
print_text($GREEN . "Bookmark $name removed.\n" . $WHITE);
} else {
print_text($RED . "ERROR: Bookmark '
--------------------------------------------------------------------
Here is some of the code that parses this:
my %scripts;
my $curr_script_section;
my $curr_script_file;
my $curr_script;
sub handle_warn {
my $warning = $_[0];
my $file = $curr_script_file;
if ($curr_script) {
$file .= '(' . $curr_script . ')'
}
if ($curr_script_section) {
$file .= '[' . $curr_script_section . ']'
}
my $line = 0;
if ($warning =~ s/\(eval \d+\) line (\d+)\.$/$file/) {
$line = $1;
$line -= 2;
$warning .= "line $line.";
}
print_text($RED . "WARNING: $WHITE");
print_text_wrap($warning . "\n");
}
$SIG{__WARN__} = \&handle_warn;
sub remove_script_file {
my ($file) = @_;
delete $scripts{$file};
}
sub eval_script_code {
my ($script_file, $script, $section, $code) = @_;
local $SIG{__WARN__} = sub {
return if $_[0] =~ /redefined at/;
&handle_warn(@_);
};
$curr_script_section = $section;
$curr_script_file = $script_file;
$curr_script = $script;
debug("Executing $script($section) from file $script_file");
eval $code;
$curr_script_file = 'main';
$curr_script = '';
$curr_script_section = '';
if ($@) {
print_text("Error(s) in script file '$script_file' $script($section)
(aborting and unloading)\n", $@);
remove_script_file($script_file);
return 0;
}
return 1;
}
sub process_script_file {
my ($file) = @_;
if ($scripts{$file}{'sections'}{'INIT'}) {
eval_script_code $file, '', 'INIT', $scripts{$file}{'sections'}{'INIT'}
or return 0;
}
foreach my $script (keys %{$scripts{$file}{'scripts'}}) {
if ($scripts{$file}{'scripts'}{$script}{'sections'}{'INFO'}) {
eval_script_code $file, $script, 'INFO',
$scripts{$file}{'scripts'}{$script}{'sections'}{'INFO'} or return 0;
}
if ($scripts{$file}{'scripts'}{$script}{'sections'}{'FUNCTIONS'}) {
eval_script_code $file, $script, 'FUNCTIONS',
$scripts{$file}{'scripts'}{$script}{'sections'}{'FUNCTIONS'} or return 0;
}
}
return 1;
}
sub read_script_file {
my ($file) = @_;
return unless $file;
remove_script_file($file);
if (is_script_file_disabled($file)) {
print_text(" Skipping $file (disabled)\n");
return;
}
if (open(CODE, "$global_data{'settings'}{'main'}{'script_dir'}/$file")) {
print_text(" Reading $file...");
my $section = '';
my $script = '';
while (my $line = <CODE>) {
if ($line =~ /^\s*#\s*SECTION\(([^)]+)\)/) {
$section = $1;
} elsif ($line =~ /^\s*#\s*SCRIPT\(([^)]+)\): (.+)/) {
$script = $1;
$scripts{$file}{'scripts'}{$script}{'name'} = $script;
$scripts{$file}{'scripts'}{$script}{'desc'} = $2;
} elsif ($line =~ /^\s*#\s*USER\s+SCRIPT\(([^)]+)\): (.+)/) {
$script = $1;
$scripts{$file}{'scripts'}{$script}{'name'} = $script;
$scripts{$file}{'scripts'}{$script}{'desc'} = $2;
$scripts{$file}{'scripts'}{$script}{'user'} = 1;
} else {
$line =~ s/__SCRIPT_FILE__/'$file'/g;
if ($script) {
$scripts{$file}{'scripts'}{$script}{'sections'}{$section} .=
$line;
} else {
$scripts{$file}{'sections'}{$section} .= $line;
}
}
}
close CODE;
if (process_script_file($file)) {
print_text("$GREEN OK$WHITE.\n");
$scripts{$file}{'mod_time'} =
(stat("$global_data{'settings'}{'main'}{'script_dir'}/$file"))[9];
}
}
}
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>
