[win32] integrate mainline
[p5sagit/p5-mst-13.2.git] / ext / Opcode / Safe.pm
index f15dbd5..c9d7416 100644 (file)
@@ -1,14 +1,13 @@
 package Safe;
 
-require 5.002;
-
+use 5.003_11;
 use strict;
-use Carp;
-
 use vars qw($VERSION);
 
 $VERSION = "2.06";
 
+use Carp;
+
 use Opcode 1.01, qw(
     opset opset_to_ops opmask_add
     empty_opset full_opset invert_opset verify_opset
@@ -151,26 +150,27 @@ sub share_from {
     my $vars = shift;
     my $no_record = shift || 0;
     my $root = $obj->root();
-    my ($var, $arg);
     croak("vars not an array ref") unless ref $vars eq 'ARRAY';
        no strict 'refs';
     # Check that 'from' package actually exists
     croak("Package \"$pkg\" does not exist")
        unless keys %{"$pkg\::"};
+    my $arg;
     foreach $arg (@$vars) {
        # catch some $safe->share($var) errors:
        croak("'$arg' not a valid symbol table name")
            unless $arg =~ /^[\$\@%*&]?\w[\w:]*$/
                or $arg =~ /^\$\W$/;
-       ($var = $arg) =~ s/^(\W)//;     # get type char
-       # warn "share_from $pkg $1 $var";
-       *{$root."::$var"} = ($1 eq '$') ? \${$pkg."::$var"}
-                         : ($1 eq '@') ? \@{$pkg."::$var"}
-                         : ($1 eq '%') ? \%{$pkg."::$var"}
-                         : ($1 eq '*') ?  *{$pkg."::$var"}
-                         : ($1 eq '&') ? \&{$pkg."::$var"}
-                         : (!$1)       ? \&{$pkg."::$var"}
-                         : croak(qq(Can't share "$1$var" of unknown type));
+       my ($var, $type);
+       $type = $1 if ($var = $arg) =~ s/^(\W)//;
+       # warn "share_from $pkg $type $var";
+       *{$root."::$var"} = (!$type)       ? \&{$pkg."::$var"}
+                         : ($type eq '&') ? \&{$pkg."::$var"}
+                         : ($type eq '$') ? \${$pkg."::$var"}
+                         : ($type eq '@') ? \@{$pkg."::$var"}
+                         : ($type eq '%') ? \%{$pkg."::$var"}
+                         : ($type eq '*') ?  *{$pkg."::$var"}
+                         : croak(qq(Can't share "$type$var" of unknown type));
     }
     $obj->share_record($pkg, $vars) unless $no_record or !$vars;
 }
@@ -287,8 +287,8 @@ compilation to fail with an error. The code will not be executed.
 The default operator mask for a newly created compartment is
 the ':default' optag.
 
-It is important that you read the L<Opcode(3)> module documentation
-for more information. Especially for details definitions of opnames,
+It is important that you read the Opcode(3) module documentation
+for more information, especially for detailed definitions of opnames,
 optags and opsets.
 
 Since it is only at the compilation stage that the operator mask
@@ -454,7 +454,7 @@ problem.
 
 Consider a function foo() in package pkg compiled outside a compartment
 but shared with it. Assume the compartment has a root package called
-'Root'. If foo() contains an eval statement like eval '$baz = 1' then,
+'Root'. If foo() contains an eval statement like eval '$foo = 1' then,
 normally, $pkg::foo will be set to 1.  If foo() is called from the
 compartment (by whatever means) then instead of setting $pkg::foo, the
 eval will actually set $Root::pkg::foo.
@@ -549,7 +549,7 @@ Originally designed and implemented by Malcolm Beattie,
 mbeattie@sable.ox.ac.uk.
 
 Reworked to use the Opcode module and other changes added by Tim Bunce
-<Tim.Bunce@ig.co.uk>.
+E<lt>F<Tim.Bunce@ig.co.uk>E<gt>.
 
 =cut