[perl #22236] File::Basename behavior is misleading

[perl5.git] / lib / Devel / SelfStubber.pm

diff --git a/lib/Devel/SelfStubber.pm b/lib/Devel/SelfStubber.pm
index 4c2d039..bfdb443 100644 (file)
--- a/lib/Devel/SelfStubber.pm
+++ b/lib/Devel/SelfStubber.pm
@@ -1,9 +1,11 @@
 package Devel::SelfStubber;
+use File::Spec;
 require SelfLoader;
 @ISA = qw(SelfLoader);
 @EXPORT = 'AUTOLOAD';
 $JUST_STUBS = 1;
-$VERSION = 1.01; sub Version {$VERSION}
+$VERSION = 1.03;
+sub Version {$VERSION}
 
 # Use as
 # perl -e 'use Devel::SelfStubber;Devel::SelfStubber->stub(MODULE_NAME,LIB)'
@@ -27,35 +29,46 @@ sub _package_defined {
 
 sub stub {
     my($self,$module,$lib) = @_;
-    my($line,$end,$fh,$mod_file,$found_selfloader);
-    $lib ||= '.';
+    my($line,$end_data,$fh,$mod_file,$found_selfloader);
+    $lib ||= File::Spec->curdir();
     ($mod_file = $module) =~ s,::,/,g;
+    $mod_file =~ tr|/|:| if $^O eq 'MacOS';
     
-    $mod_file = "$lib/$mod_file.pm";
+    $mod_file = File::Spec->catfile($lib, "$mod_file.pm");
     $fh = "${module}::DATA";
+    my (@BEFORE_DATA, @AFTER_DATA, @AFTER_END);
+    @DATA = @STUBS = ();
 
     open($fh,$mod_file) || die "Unable to open $mod_file";
+    local $/ = "\n";
     while(defined ($line = <$fh>) and $line !~ m/^__DATA__/) {
        push(@BEFORE_DATA,$line);
        $line =~ /use\s+SelfLoader/ && $found_selfloader++;
     }
-    $line =~ m/^__DATA__/ || die "$mod_file doesn't contain a __DATA__ token";
+    (defined ($line) && $line =~ m/^__DATA__/)
+      || die "$mod_file doesn't contain a __DATA__ token";
     $found_selfloader || 
        print 'die "\'use SelfLoader;\' statement NOT FOUND!!\n"',"\n";
-    $self->_load_stubs($module);
+    if ($JUST_STUBS) {
+        $self->_load_stubs($module);
+    } else {
+        $self->_load_stubs($module, \@AFTER_END);
+    }
     if ( fileno($fh) ) {
-       $end = 1;
+       $end_data = 1;
        while(defined($line = <$fh>)) {
            push(@AFTER_DATA,$line);
        }
     }
+    close($fh);
     unless ($JUST_STUBS) {
        print @BEFORE_DATA;
     }
     print @STUBS;
     unless ($JUST_STUBS) {
        print "1;\n__DATA__\n",@DATA;
-       if($end) { print "__END__\n",@AFTER_DATA; }
+       if($end_data) { print "__END__ DATA\n",@AFTER_DATA; }
+       if(@AFTER_END) { print "__END__\n",@AFTER_END; }
     }
 }