This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #116975] perlfunc require: fix example subroutine
authorDavid Golden <dagolden@cpan.org>
Tue, 9 Jul 2013 01:45:42 +0000 (11:45 +1000)
committerTony Cook <tony@develop-help.com>
Tue, 9 Jul 2013 01:46:24 +0000 (11:46 +1000)
pod/perlfunc.pod

index 3a5d473..8f157fd 100644 (file)
@@ -5778,13 +5778,24 @@ Otherwise, C<require> demands that a library file be included if it
 hasn't already been included.  The file is included via the do-FILE
 mechanism, which is essentially just a variety of C<eval> with the
 caveat that lexical variables in the invoking script will be invisible
 hasn't already been included.  The file is included via the do-FILE
 mechanism, which is essentially just a variety of C<eval> with the
 caveat that lexical variables in the invoking script will be invisible
-to the included code.  Has semantics similar to the following subroutine:
+to the included code.  If it were implemented in pure Perl, it
+would have semantics similar to the following:
+
+    use Carp 'croak';
+    use version;
 
     sub require {
        my ($filename) = @_;
 
     sub require {
        my ($filename) = @_;
+       if ( my $version = eval { version->parse($filename) } ) {
+           if ( $version > $^V ) {
+               my $vn = $version->normal;
+               croak "Perl $vn required--this is only $^V, stopped";
+           }
+           return 1;
+       }
        if (exists $INC{$filename}) {
            return 1 if $INC{$filename};
        if (exists $INC{$filename}) {
            return 1 if $INC{$filename};
-           die "Compilation failed in require";
+           croak "Compilation failed in require";
        }
        my ($realfilename,$result);
        ITER: {
        }
        my ($realfilename,$result);
        ITER: {
@@ -5792,19 +5803,25 @@ to the included code.  Has semantics similar to the following subroutine:
                $realfilename = "$prefix/$filename";
                if (-f $realfilename) {
                    $INC{$filename} = $realfilename;
                $realfilename = "$prefix/$filename";
                if (-f $realfilename) {
                    $INC{$filename} = $realfilename;
-                   $result = do $realfilename;
+                   my $caller = caller;
+                   my $do_as_caller = eval qq{
+                       package $caller;
+                       sub { do \$_[0] }
+                   };
+                   $result = $do_as_caller->($realfilename);
                    last ITER;
                }
            }
                    last ITER;
                }
            }
-           die "Can't find $filename in \@INC";
+           croak "Can't locate $filename in \@INC";
        }
        if ($@) {
            $INC{$filename} = undef;
        }
        if ($@) {
            $INC{$filename} = undef;
-           die $@;
+           croak $@;
        } elsif (!$result) {
            delete $INC{$filename};
        } elsif (!$result) {
            delete $INC{$filename};
-           die "$filename did not return true value";
+           croak "$filename did not return true value";
        } else {
        } else {
+           $! = 0;
            return $result;
        }
     }
            return $result;
        }
     }