Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for which.pl

(view source code of which.pl as plain text) 

  1. #! perl
  2.  
  3. # Check command line argument(s)
  4. if ( !@ARGV[0] or @ARGV[1] or !( @ARGV[0] =~ m/^[-\w]+(\.\w+)?$/ ) ) {
  5. 	print "\nWhich.pl,  Version 2.00\n";
  6. 	print "Locate the specified program file\n";
  7. 	print "Port of Unix' WHICH command\n\n";
  8. 	print "Usage:  WHICH.PL  filename[.ext]\n\n";
  9. 	print "Where:  \"filename\" is a file name only: no path, no wildcards\n\n";
  10. 	print "Note:   This script ignores DOSKEY macros and internal commands, and\n";
  11. 	print "        returns external commands (executable or script file names) only.\n\n";
  12. 	print "Written by Rob van der Woude\n";
  13. 	print "http://www.robvanderwoude.com\n";
  14. 	exit(2);
  15. }
  16.  
  17. # Store PATH and PATHEXT in arrays
  18. while ( ( $key, $value ) = each %ENV ) {
  19. 	if ( uc( $key ) eq "PATH" ) {
  20. 		# Current directory must be searched before the PATH
  21. 		@path    = ( ".", split( /;+/,$value ) );
  22. 	} elsif ( uc( $key ) eq "PATHEXT" ) {
  23. 		# Search for "non-executable" program files too
  24. 		@pathext = ( split( /;+/,$value ) );
  25. 	}
  26. }
  27.  
  28. # Search code in labelled block, to allow quitting the loop
  29. SEARCH: {
  30. 	# Search each directory specified in PATH
  31. 	foreach ( @path ) {
  32. 		$d = $_;
  33. 		# Remove trailing backslash or backslash plus dot
  34. 		$d =~ s/^(.*)\\\.?$/\1/;
  35. 		# Read the directory (files only)
  36. 		opendir( SEARCHDIR, $d ) or die "Cannot open directory $d:\n$!";
  37. 		readdir ( SEARCHDIR );
  38. 		@files = grep { -f "$d\\$_" } readdir( SEARCHDIR );
  39. 		foreach $file ( @files ) {
  40. 			# Check for specified file name both with
  41. 			# and without each extension from PATHEXT
  42. 			if ( @ARGV[0] =~ m/^[^.]=\.[^.]+$/ ) {
  43. 				if ( $file =~ m/^@ARGV[0]$/i ) {
  44. 					# Display result
  45. 					print "\n$d\\$file\n";
  46. 					# Close directory handle
  47. 					closedir( SEARCHDIR );
  48. 					# Abort search at first successful find
  49. 					last SEARCH;
  50. 				}
  51. 			} else {
  52. 				foreach $ext ( @pathext ) {
  53. 					if ( $file =~ m/^@ARGV[0]($ext)$/i ) {
  54. 						# Display result
  55. 						print "\n$d\\$file\n";
  56. 						# Close directory handle
  57. 						closedir( SEARCHDIR );
  58. 						# Abort search at first successful find
  59. 						last SEARCH;
  60. 					}
  61. 				}
  62. 			}
  63. 		}
  64. 		# Close directory handle
  65. 		closedir( SEARCHDIR );
  66. 	}
  67. 	# If you arrived here, the search was unsuccessful
  68. 	print "\n-None-\n";
  69. 	exit(1);
  70. }
  71.  

page last modified: 2024-04-16; loaded in 0.0057 seconds