… | |
… | |
624 | } |
624 | } |
625 | |
625 | |
626 | ############################################################################# |
626 | ############################################################################# |
627 | # map scripting support |
627 | # map scripting support |
628 | |
628 | |
629 | our $safe = new Safe "ext"; |
629 | our $safe = new Safe "safe"; |
630 | our $safe_hole = new Safe::Hole; |
630 | our $safe_hole = new Safe::Hole; |
631 | |
631 | |
632 | $SIG{FPE} = 'IGNORE'; |
632 | $SIG{FPE} = 'IGNORE'; |
633 | |
633 | |
634 | $safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time)); |
634 | $safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time)); |
… | |
… | |
654 | $qcode =~ s/\n/\\n/g; |
654 | $qcode =~ s/\n/\\n/g; |
655 | |
655 | |
656 | local $_; |
656 | local $_; |
657 | local @safe::cf::_safe_eval_args = values %vars; |
657 | local @safe::cf::_safe_eval_args = values %vars; |
658 | |
658 | |
659 | $code = |
659 | my $eval = |
660 | "do {\n" |
660 | "do {\n" |
661 | . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" |
661 | . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" |
662 | . "#line 0 \"{$qcode}\"\n" |
662 | . "#line 0 \"{$qcode}\"\n" |
663 | . $code |
663 | . $code |
664 | . "\n}" |
664 | . "\n}" |
665 | ; |
665 | ; |
666 | |
666 | |
667 | sub_generation_inc; |
667 | sub_generation_inc; |
668 | my @res = wantarray ? $safe->reval ($code) : scalar $safe->reval ($code); |
668 | my @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); |
669 | sub_generation_inc; |
669 | sub_generation_inc; |
|
|
670 | |
|
|
671 | if ($@) { |
|
|
672 | warn "$@"; |
|
|
673 | warn "while executing safe code '$code'\n"; |
|
|
674 | warn "with arguments " . (join " ", %vars) . "\n"; |
|
|
675 | } |
670 | |
676 | |
671 | wantarray ? @res : $res[0] |
677 | wantarray ? @res : $res[0] |
672 | } |
678 | } |
673 | |
679 | |
674 | sub register_script_function { |
680 | sub register_script_function { |