use Script ();
# Data extracted from XML.
my %snippets = (
onInit => 'use strict; my $x=2;',
onAwaken => 'print ++$y;',
);
my $script = Script->new(\%snippets);
$script->onInit();
$script->onAwaken();
####
Global symbol "$y" requires explicit package name in onAwaken.
####
use strict;
use warnings;
package Script;
# Constants.
my @events = qw(
preRestore
onRestore
onAttach
onInit
onAwaken
onChange
); # Ordered.
my %events = map { $events[$_] => $_ } 0..$#events;
sub new {
my ($class, $snippets) = @_;
my @event_line_nums;
my $code = "sub {\n";
$code .= " my \$event_num = shift;\n";
$code .= " goto __$events[$_] if \$event_num == $_;\n"
foreach 0 .. $#events;
foreach my $event (@events) {
push @event_line_nums, (() = $code =~ /\n/g) + 1;
if (defined $snippets->{$event}) {
$code .= "__$event: 1;\n$snippets->{$event}; return;\n";
} else {
$code .= "__$event: return;\n";
}
}
$code .= "\n}\n";
my $sub = eval $code;
if ($@) {
my ($error_msg, $line_num) =
$@ =~ /^(.*) at \(eval \d+\) line (\d+)/s;
my $error_event;
foreach my $event_num (0..$#events) {
last if $line_num < $event_line_nums[$event_num];
$error_event = $event_num;
}
die("$error_msg in $events[$error_event].\n");
}
return bless($sub, $class);
}
sub _dispatch {
my $sub = shift;
my $event_num = shift;
$rv = eval { $sub->($event_num, @_) };
if ($@) {
my ($error_msg) =
$@ =~ /^(.*) at \(eval \d+\) line /s;
die("$error_msg in $events[$event_num].\n");
}
return $rv;
}
eval "sub $_ { shift->_dispatch($events{$_}, \@_); }"
foreach @events;
1;