| … | |
… | |
| 2009 | |
2009 | |
| 2010 | $cf::MAP{$path} = $map |
2010 | $cf::MAP{$path} = $map |
| 2011 | } |
2011 | } |
| 2012 | } |
2012 | } |
| 2013 | |
2013 | |
| 2014 | sub pre_load { } |
2014 | sub pre_load { } |
| 2015 | sub post_load { } |
2015 | #sub post_load { } # XS |
| 2016 | |
2016 | |
| 2017 | sub load { |
2017 | sub load { |
| 2018 | my ($self) = @_; |
2018 | my ($self) = @_; |
| 2019 | |
2019 | |
| 2020 | local $self->{deny_reset} = 1; # loading can take a long time |
2020 | local $self->{deny_reset} = 1; # loading can take a long time |
| … | |
… | |
| 3203 | $qcode =~ s/"/‟/g; # not allowed in #line filenames |
3203 | $qcode =~ s/"/‟/g; # not allowed in #line filenames |
| 3204 | $qcode =~ s/\n/\\n/g; |
3204 | $qcode =~ s/\n/\\n/g; |
| 3205 | |
3205 | |
| 3206 | %vars = (_dummy => 0) unless %vars; |
3206 | %vars = (_dummy => 0) unless %vars; |
| 3207 | |
3207 | |
|
|
3208 | my @res; |
| 3208 | local $_; |
3209 | local $_; |
| 3209 | local @safe::cf::_safe_eval_args = values %vars; |
|
|
| 3210 | |
3210 | |
| 3211 | my $eval = |
3211 | my $eval = |
| 3212 | "do {\n" |
3212 | "do {\n" |
| 3213 | . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" |
3213 | . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" |
| 3214 | . "#line 0 \"{$qcode}\"\n" |
3214 | . "#line 0 \"{$qcode}\"\n" |
| 3215 | . $code |
3215 | . $code |
| 3216 | . "\n}" |
3216 | . "\n}" |
| 3217 | ; |
3217 | ; |
| 3218 | |
3218 | |
|
|
3219 | if ($CFG{safe_eval}) { |
| 3219 | sub_generation_inc; |
3220 | sub_generation_inc; |
|
|
3221 | local @safe::cf::_safe_eval_args = values %vars; |
| 3220 | my @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); |
3222 | @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); |
| 3221 | sub_generation_inc; |
3223 | sub_generation_inc; |
|
|
3224 | } else { |
|
|
3225 | local @cf::_safe_eval_args = values %vars; |
|
|
3226 | @res = wantarray ? eval eval : scalar eval $eval; |
|
|
3227 | } |
| 3222 | |
3228 | |
| 3223 | if ($@) { |
3229 | if ($@) { |
| 3224 | warn "$@"; |
3230 | warn "$@"; |
| 3225 | warn "while executing safe code '$code'\n"; |
3231 | warn "while executing safe code '$code'\n"; |
| 3226 | warn "with arguments " . (join " ", %vars) . "\n"; |
3232 | warn "with arguments " . (join " ", %vars) . "\n"; |
| … | |
… | |
| 3245 | =cut |
3251 | =cut |
| 3246 | |
3252 | |
| 3247 | sub register_script_function { |
3253 | sub register_script_function { |
| 3248 | my ($fun, $cb) = @_; |
3254 | my ($fun, $cb) = @_; |
| 3249 | |
3255 | |
| 3250 | no strict 'refs'; |
3256 | $fun = "safe::$fun" if $CFG{safe_eval}; |
| 3251 | *{"safe::$fun"} = $safe_hole->wrap ($cb); |
3257 | *$fun = $safe_hole->wrap ($cb); |
| 3252 | } |
3258 | } |
| 3253 | |
3259 | |
| 3254 | =back |
3260 | =back |
| 3255 | |
3261 | |
| 3256 | =cut |
3262 | =cut |
| … | |
… | |
| 3277 | |
3283 | |
| 3278 | $facedata->{version} == 2 |
3284 | $facedata->{version} == 2 |
| 3279 | or cf::cleanup "$path: version mismatch, cannot proceed."; |
3285 | or cf::cleanup "$path: version mismatch, cannot proceed."; |
| 3280 | |
3286 | |
| 3281 | # patch in the exptable |
3287 | # patch in the exptable |
|
|
3288 | my $exp_table = $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]); |
| 3282 | $facedata->{resource}{"res/exp_table"} = { |
3289 | $facedata->{resource}{"res/exp_table"} = { |
| 3283 | type => FT_RSRC, |
3290 | type => FT_RSRC, |
| 3284 | data => $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]), |
3291 | data => $exp_table, |
|
|
3292 | hash => (Digest::MD5::md5 $exp_table), |
| 3285 | }; |
3293 | }; |
| 3286 | cf::cede_to_tick; |
3294 | cf::cede_to_tick; |
| 3287 | |
3295 | |
| 3288 | { |
3296 | { |
| 3289 | my $faces = $facedata->{faceinfo}; |
3297 | my $faces = $facedata->{faceinfo}; |
