Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

115 lines
4.3 KiB

  1. # NOTE: Derived from ../LIB\DynaLoader.pm.
  2. # Changes made here will be lost when autosplit is run again.
  3. # See AutoSplit.pm.
  4. package DynaLoader;
  5. #line 241 "../LIB\DynaLoader.pm (autosplit into ..\lib\auto\DynaLoader\dl_findfile.al)"
  6. sub dl_findfile {
  7. # Read ext/DynaLoader/DynaLoader.doc for detailed information.
  8. # This function does not automatically consider the architecture
  9. # or the perl library auto directories.
  10. my (@args) = @_;
  11. my (@dirs, $dir); # which directories to search
  12. my (@found); # full paths to real files we have found
  13. my $dl_ext= 'dll'; # $Config::Config{'dlext'} suffix for perl extensions
  14. my $dl_so = 'dll'; # $Config::Config{'so'} suffix for shared libraries
  15. print STDERR "dl_findfile(@args)\n" if $dl_debug;
  16. # accumulate directories but process files as they appear
  17. arg: foreach(@args) {
  18. # Special fast case: full filepath requires no search
  19. if ($Is_VMS && m%[:>/\]]% && -f $_) {
  20. push(@found,dl_expandspec(VMS::Filespec::vmsify($_)));
  21. last arg unless wantarray;
  22. next;
  23. }
  24. elsif ($Is_MacOS) {
  25. if (m/:/ && -f $_) {
  26. push(@found,$_);
  27. last arg unless wantarray;
  28. }
  29. }
  30. elsif (m:/: && -f $_ && !$do_expand) {
  31. push(@found,$_);
  32. last arg unless wantarray;
  33. next;
  34. }
  35. # Deal with directories first:
  36. # Using a -L prefix is the preferred option (faster and more robust)
  37. if (m:^-L:) { s/^-L//; push(@dirs, $_); next; }
  38. if ($Is_MacOS) {
  39. # Otherwise we try to try to spot directories by a heuristic
  40. # (this is a more complicated issue than it first appears)
  41. if (m/:/ && -d $_) { push(@dirs, $_); next; }
  42. # Only files should get this far...
  43. my(@names, $name); # what filenames to look for
  44. s/^-l//;
  45. push(@names, $_);
  46. foreach $dir (@dirs, @dl_library_path) {
  47. next unless -d $dir;
  48. $dir =~ s/^([^:]+)$/:$1/;
  49. $dir =~ s/:$//;
  50. foreach $name (@names) {
  51. my($file) = "$dir:$name";
  52. print STDERR " checking in $dir for $name\n" if $dl_debug;
  53. if (-f $file) {
  54. push(@found, $file);
  55. next arg; # no need to look any further
  56. }
  57. }
  58. }
  59. next;
  60. }
  61. # Otherwise we try to try to spot directories by a heuristic
  62. # (this is a more complicated issue than it first appears)
  63. if (m:/: && -d $_) { push(@dirs, $_); next; }
  64. # VMS: we may be using native VMS directory syntax instead of
  65. # Unix emulation, so check this as well
  66. if ($Is_VMS && /[:>\]]/ && -d $_) { push(@dirs, $_); next; }
  67. # Only files should get this far...
  68. my(@names, $name); # what filenames to look for
  69. if (m:-l: ) { # convert -lname to appropriate library name
  70. s/-l//;
  71. push(@names,"lib$_.$dl_so");
  72. push(@names,"lib$_.a");
  73. } else { # Umm, a bare name. Try various alternatives:
  74. # these should be ordered with the most likely first
  75. push(@names,"$_.$dl_ext") unless m/\.$dl_ext$/o;
  76. push(@names,"$_.$dl_so") unless m/\.$dl_so$/o;
  77. push(@names,"lib$_.$dl_so") unless m:/:;
  78. push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs";
  79. push(@names, $_);
  80. }
  81. foreach $dir (@dirs, @dl_library_path) {
  82. next unless -d $dir;
  83. chop($dir = VMS::Filespec::unixpath($dir)) if $Is_VMS;
  84. foreach $name (@names) {
  85. my($file) = "$dir/$name";
  86. print STDERR " checking in $dir for $name\n" if $dl_debug;
  87. $file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file);
  88. #$file = _check_file($file);
  89. if ($file) {
  90. push(@found, $file);
  91. next arg; # no need to look any further
  92. }
  93. }
  94. }
  95. }
  96. if ($dl_debug) {
  97. foreach(@dirs) {
  98. print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
  99. }
  100. print STDERR "dl_findfile found: @found\n";
  101. }
  102. return $found[0] unless wantarray;
  103. @found;
  104. }
  105. # end of DynaLoader::dl_findfile
  106. 1;