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
-
[PATCH] Cleanup FindBin.pm and it's tests
by Casey West