develooper Front page | perl.perl5.porters | Postings from April 2001

[PATCH] Cleanup FindBin.pm and it's tests

Thread Next
From:
Casey West
Date:
April 25, 2001 11:01
Subject:
[PATCH] Cleanup FindBin.pm and it's tests
Message ID:
20010425130206.A22658@stupid.geeknest.com
"Clean up, clean up, everybody do you share..."

Among other things, making FindBin use strict and warnings, and adding
test cases that make sense.

--- bleadperl.old/lib/FindBin.pm	Wed Apr 18 15:30:49 2001
+++ bleadperl/lib/FindBin.pm	Wed Apr 25 12:18:49 2001
@@ -1,9 +1,115 @@
-# FindBin.pm
-#
+package FindBin;
+
 # Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
 # This program is free software; you can redistribute it and/or modify it
 # under the same terms as Perl itself.
 
+use 5.005_64;
+
+use strict;
+use warnings::register;
+use Carp;
+use Cwd qw(getcwd abs_path);
+use Config;
+use File::Basename;
+use File::Spec;
+
+require Exporter;
+
+our $Bin;
+our $Dir;
+our $Script;
+our $RealBin;
+our $RealDir;
+our $RealScript;
+
+our %EXPORT_TAGS = (
+		    ALL => [
+			    qw(
+			       $Bin     $Dir     $Script
+			       $RealBin $RealDir $RealScript
+			      ),
+			   ],
+		   );
+
+our @EXPORT_OK   = @{ $EXPORT_TAGS{ALL} };
+our @ISA         = qw(Exporter);
+
+our $VERSION = "1.43";
+
+BEGIN {
+  if( $0 =~ /^-e?$/ ) {
+    # perl invoked with -e or script is on C<STDIN>
+
+   $Script = $RealScript = $0;
+   $Bin    = $RealBin    = getcwd();
+  } else {
+    my $script = $0;
+
+    if ( $^O eq 'VMS' ) {
+      ( $RealBin, $RealScript ) = ( $Bin, $Script ) =
+	VMS::Filespec::rmsexpand( $0 ) =~ /(.*\])(.*)/s;
+    } else {
+      my $IsWin32 = $^O eq 'MSWin32';
+      unless(
+	     ( $script =~ m#/# ||
+	       ( $IsWin32 && $script =~ m#\\# )
+	     ) && -f $script
+	    ) {
+	foreach my $dir ( File::Spec->path ) {
+	  my $scr = File::Spec->catfile( $dir, $script );
+	  if( -r $scr && ( ! $IsWin32 || -x _ ) ) {
+	    $script = $scr;
+
+	    if ( -f $0 ) {
+	      # $script has been found via PATH but perl could have
+	      # been invoked as 'perl file'. Do a dumb check to see
+	      # if $script is a perl program, if not then $script = $0
+	      #
+	      # well we actually only check that it is an ASCII file
+	      # we know its executable so it is probably a script
+	      # of some sort.
+
+	      $script = $0 unless -T $script;
+	    }
+	    last;
+	  }
+	}
+      }
+
+      croak( "Cannot find current script '$0'" ) unless -f $script;
+
+      # Ensure $script contains the complete path incase we C<chdir>
+
+      $script = File::Spec->catfile( getcwd(), $script )
+	unless File::Spec->file_name_is_absolute( $script );
+
+      ( $Script,$Bin ) = fileparse( $script );
+
+      # Resolve $script if it is a link
+      while ( 1 ) {
+	my $linktext = readlink( $script );
+
+	( $RealScript, $RealBin ) = fileparse( $script );
+	last unless defined $linktext;
+
+	$script = File::Spec->file_name_is_absolute( $linktext )
+	  ? $linktext : File::Spec->catfile( $RealBin, $linktext );
+      }
+
+      # Get absolute paths to directories
+      $Bin     = abs_path( $Bin )     if( $Bin );
+      $RealBin = abs_path( $RealBin ) if( $RealBin );
+    }
+  }
+  $Dir     = $Bin;
+  $RealDir = $RealBin;
+}
+
+1;
+
+__END__
+
 =head1 NAME
 
 FindBin - Locate directory of original perl script
@@ -35,8 +141,10 @@
 =head1 EXPORTABLE VARIABLES
 
  $Bin         - path to bin directory from where script was invoked
+ $Dir         - alias to $Bin
  $Script      - basename of script from which perl was invoked
  $RealBin     - $Bin with all links resolved
+ $RealDir     - alias to $RealBin
  $RealScript  - $Script with all links resolved
 
 =head1 KNOWN BUGS
@@ -61,109 +169,10 @@
 Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
 Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
 
+Clean up and (more) tests by Casey West E<lt>F<casey@geeknest.com>E<gt>
+
 =head1 COPYRIGHT
 
 Copyright (c) 1995 Graham Barr & Nick Ing-Simmons. All rights reserved.
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.
-
-=cut
-
-package FindBin;
-use Carp;
-require 5.000;
-require Exporter;
-use Cwd qw(getcwd abs_path);
-use Config;
-use File::Basename;
-use File::Spec;
-
-@EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
-%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
-@ISA = qw(Exporter);
-
-$VERSION = "1.42";
-
-BEGIN
-{
- *Dir = \$Bin;
- *RealDir = \$RealBin;
-
- if($0 eq '-e' || $0 eq '-')
-  {
-   # perl invoked with -e or script is on C<STDIN>
-
-   $Script = $RealScript = $0;
-   $Bin    = $RealBin    = getcwd();
-  }
- else
-  {
-   my $script = $0;
-
-   if ($^O eq 'VMS')
-    {
-     ($Bin,$Script) = VMS::Filespec::rmsexpand($0) =~ /(.*\])(.*)/s;
-     ($RealBin,$RealScript) = ($Bin,$Script);
-    }
-   else
-    {
-     my $IsWin32 = $^O eq 'MSWin32';
-     unless(($script =~ m#/# || ($IsWin32 && $script =~ m#\\#))
-            && -f $script)
-      {
-       my $dir;
-       foreach $dir (File::Spec->path)
-	{
-        my $scr = File::Spec->catfile($dir, $script);
-	if(-r $scr && (!$IsWin32 || -x _))
-         {
-          $script = $scr;
-
-	  if (-f $0)
-           {
-	    # $script has been found via PATH but perl could have
-	    # been invoked as 'perl file'. Do a dumb check to see
-	    # if $script is a perl program, if not then $script = $0
-            #
-            # well we actually only check that it is an ASCII file
-            # we know its executable so it is probably a script
-            # of some sort.
-
-            $script = $0 unless(-T $script);
-           }
-          last;
-         }
-       }
-     }
-
-     croak("Cannot find current script '$0'") unless(-f $script);
-
-     # Ensure $script contains the complete path incase we C<chdir>
-
-     $script = File::Spec->catfile(getcwd(), $script)
-       unless File::Spec->file_name_is_absolute($script);
-
-     ($Script,$Bin) = fileparse($script);
-
-     # Resolve $script if it is a link
-     while(1)
-      {
-       my $linktext = readlink($script);
-
-       ($RealScript,$RealBin) = fileparse($script);
-       last unless defined $linktext;
-
-       $script = (File::Spec->file_name_is_absolute($linktext))
-                  ? $linktext
-                  : File::Spec->catfile($RealBin, $linktext);
-      }
-
-     # Get absolute paths to directories
-     $Bin     = abs_path($Bin)     if($Bin);
-     $RealBin = abs_path($RealBin) if($RealBin);
-    }
-  }
-}
-
-1; # Keep require happy
-
--- bleadperl.old/t/lib/findbin.t	Wed Apr 18 15:30:55 2001
+++ bleadperl/t/lib/findbin.t	Wed Apr 25 12:17:44 2001
@@ -5,9 +5,27 @@
     @INC = '../lib';
 }
 
-print "1..1\n";
+print "1..7\n";
 
-use FindBin qw($Bin);
+use FindBin qw($Bin $Script $Dir $RealBin $RealDir $RealScript);
 
-print "not " unless $Bin =~ m,t[/.]lib\]?$,;
+print "not " unless $Bin =~ m#t[/.]lib\]?$#;
 print "ok 1\n";
+
+print "not " unless $0 =~ /$Script$/;
+print "ok 2\n";
+
+print "not " unless "$Bin/$Script" =~ /$0$/;;
+print "ok 3\n";
+
+print "not " unless $Bin eq $Dir;
+print "ok 4\n";
+
+print "not " unless $RealBin eq $Bin;
+print "ok 5\n";
+
+print "not " unless $RealDir eq $Dir;
+print "ok 6\n";
+
+print "not " unless $RealScript eq $Script;
+print "ok 7\n";


-- 
Casey West

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About