view release on metacpan or  search on metacpan

lib/Safe/World/Compartment.pm  view on Meta::CPAN

  );
}

#############################################################################

use vars qw($VERSION @ISA) ;

$VERSION = '0.02' ;

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
*Opcode_safe_pkg_prep = \&Opcode::_safe_pkg_prep ;

my $default_share = ['*_'] ;

my $SCALAR_R ; tie( $SCALAR_R , 'Safe::World::Compartment::SCALAR_R') ;

#############################################################################

sub new {
  my($class, $root) = @_;

lib/Safe/World/Compartment.pm  view on Meta::CPAN

    $^R = undef ; ## Ensure that is reseted.
  }
  
  Opcode_safe_pkg_prep($root) if($Opcode::VERSION > 1.04);
  
  return $obj;
}

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

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

sub permit_only {
  my $obj = shift;
  $obj->{Mask} = invert_opset opset(@_);
}

sub share_from {
  my $obj = shift;
  my $pkg = shift;
  my $vars = shift;

  my $root = $obj->{Root} ;

  return undef if ref($vars) ne 'ARRAY' ;