view release on metacpan or  search on metacpan

lib/Eval/Safe/ForkedSafe.pm  view on Meta::CPAN

    if (defined &B::sub_generation) {
        *sub_generation = \&B::sub_generation;
    }
    else {
        # fake sub generation changing for perls < 5.8.9
        my $sg; *sub_generation = sub { ++$sg };
    }
}

use Opcode 1.01, qw(
    opset opset_to_ops opmask_add
    empty_opset full_opset invert_opset verify_opset
    opdesc opcodes opmask define_optag opset_to_hex
);

*ops_to_opset = \&opset;   # Temporary alias for old Penguins

# Regular expressions and other unicode-aware code may need to call
# utf8->SWASHNEW (via perl's utf8.c).  That will fail unless we share the
# SWASHNEW method.
# Sadly we can't just add utf8::SWASHNEW to $default_share because perl's
# utf8.c code does a fetchmethod on SWASHNEW to check if utf8.pm is loaded,
# and sharing makes it look like the method exists.
# The simplest and most robust fix is to ensure the utf8 module is loaded when
# Safe is loaded. Then we can add utf8::SWASHNEW to $default_share.
require utf8;

lib/Eval/Safe/ForkedSafe.pm  view on Meta::CPAN

    return $obj->{Mask} unless @_;
    $obj->deny_only(@_);
}

# v1 compatibility methods
sub trap   { shift->deny(@_)   }
sub untrap { shift->permit(@_) }

sub deny {
    my $obj = shift;
    $obj->{Mask} |= opset(@_);
}
sub deny_only {
    my $obj = shift;
    $obj->{Mask} = opset(@_);
}

sub permit {
    my $obj = shift;
    # XXX needs testing
    $obj->{Mask} &= invert_opset opset(@_);
}
sub permit_only {
    my $obj = shift;
    $obj->{Mask} = invert_opset opset(@_);
}


sub dump_mask {
    my $obj = shift;
    print opset_to_hex($obj->{Mask}),"\n";
}


sub share {
    my($obj, @vars) = @_;
    $obj->share_from(scalar(caller), \@vars);
}


sub share_from {