X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FDynaLoader%2FDynaLoader_pm.PL;h=27ccd7d6bdea5eefe0decf68132f7347a2a11c18;hb=281da5eaa82c552216e167aece73c3f8df066bd4;hp=1f9a9bcc9572886057b6976bf529d29677aeb564;hpb=8225e35fda318ef1ca541a02e9cdffa311c2123d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index 1f9a9bc..27ccd7d 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -7,11 +7,68 @@ sub to_string { return "'$value'"; } +# +# subroutine expand_os_specific expands $^O-specific preprocessing information +# so that it will not be re-calculated at runtime in Dynaloader.pm +# +# Syntax of preprocessor should be kept extremely simple: +# - directives are in double angle brackets <<...>> +# - <<=string>> will be just evaluated +# - for $^O-specific there are two forms: +# <<$^O-eq-osname>> +# <<$^O-ne-osname>> +# this directive should be closed with respectively +# <> +# <> +# construct <<|$^O-ne-osname>> means #else +# nested <<$^O...>>-constructs are allowed but nested values must be for +# different OS-names! +# +# -- added by VKON, 03-10-2004 to separate $^O-specific between OSes +# (so that Win32 never checks for $^O eq 'VMS' for example) +# +# The $^O tests test both for $^O and for $Config{osname}. +# The latter is better for some for cross-compilation setups. +# +sub expand_os_specific { + my $s = shift; + for ($s) { + s/<<=(.*?)>>/$1/gee; + s/<<\$\^O-(eq|ne)-(\w+)>>(.*?)<<\/\$\^O-\1-\2>>/ + my ($op, $os, $expr) = ($1,$2,$3); + if ($op ne 'eq' and $op ne 'ne') {die "wrong eq-ne arg in $&"}; + if ($expr =~ m[^(.*?)<<\|\$\^O-$op-$os>>(.*?)$]s) { + # #if;#else;#endif + my ($if,$el) = ($1,$2); + if (($op eq 'eq' and ($^O eq $os || $Config{osname} eq $os)) || ($op eq 'ne' and ($^O ne $os || $Config{osname} ne $os))) { + $if + } + else { + $el + } + } + else { + # #if;#endif + if (($op eq 'eq' and ($^O eq $os || $Config{osname} eq $os)) || ($op eq 'ne' and ($^O ne $os || $Config{osname} ne $os))) { + $expr + } + else { + "" + } + } + /ges; + if (/<<(=|\$\^O-)/) {die "bad <<\$^O-eq/ne-osname>> expression.". + " Unclosed brackets?"; + } + } + $s; +} + unlink "DynaLoader.pm" if -f "DynaLoader.pm"; open OUT, ">DynaLoader.pm" or die $!; print OUT <<'EOT'; -# Generated from DynaLoader.pm.PL +# Generated from DynaLoader_pm.PL package DynaLoader; @@ -27,17 +84,14 @@ package DynaLoader; # # Tim.Bunce@ig.co.uk, August 1994 -$VERSION = "1.04"; # avoid typo warning +BEGIN { + $VERSION = '1.10'; +} require AutoLoader; *AUTOLOAD = \&AutoLoader::AUTOLOAD; -# The following require can't be removed during maintenance -# releases, sadly, because of the risk of buggy code that does -# require Carp; Carp::croak "..."; without brackets dying -# if Carp hasn't been loaded in earlier compile time. :-( -# We'll let those bugs get found on the development track. -require Carp if $] < 5.00450; +use Config; # enable debug/trace messages from DynaLoader perl code $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; @@ -55,25 +109,42 @@ $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; sub dl_load_flags { 0x00 } -# ($dl_dlext, $dlsrc) -# = @Config::Config{'dlext', 'dlsrc'}; EOT -print OUT " (\$dl_dlext, \$dlsrc) = (", - to_string($Config::Config{'dlext'}), ",", - to_string($Config::Config{'dlsrc'}), ")\n;" ; +if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { + print OUT "(\$dl_dlext, \$dl_so, \$dlsrc) = (", + to_string($Config{'dlext'}), ",", + to_string($Config{'so'}), ",", + to_string($Config{'dlsrc'}), ")\n;" ; +} +else { + print OUT <<'EOT'; +($dl_dlext, $dl_so, $dlsrc) = @Config::Config{qw(dlext so dlsrc)}; +EOT +} -print OUT <<'EOT'; +print OUT expand_os_specific(<<'EOT'); +<<$^O-eq-VMS>> # Some systems need special handling to expand file specifications # (VMS support by Charles Bailey ) # See dl_expandspec() for more details. Should be harmless but # inefficient to define on systems that don't need it. -$do_expand = $Is_VMS = $^O eq 'VMS'; +$Is_VMS = $^O eq 'VMS'; +<> +$do_expand = <<$^O-eq-VMS>>1<<|$^O-eq-VMS>>0<>; + +<<$^O-eq-MacOS>> +my $Mac_FS; +$Mac_FS = eval { require Mac::FileSpec::Unixish }; +<> @dl_require_symbols = (); # names of symbols we need @dl_resolve_using = (); # names of files to link with @dl_library_path = (); # path to look for files + +#XSLoader.pm may have added elements before we were required +#@dl_shared_objects = (); # shared objects for symbols we have #@dl_librefs = (); # things we have loaded #@dl_modules = (); # Modules we have loaded @@ -83,11 +154,11 @@ $do_expand = $Is_VMS = $^O eq 'VMS'; EOT my $cfg_dl_library_path = <<'EOT'; -push(@dl_library_path, split(' ', $Config::Config{'libpth'})); +push(@dl_library_path, split(' ', $Config::Config{libpth})); EOT sub dquoted_comma_list { - join(", ", map {qq("$_")} @_); + join(", ", map {'"'.quotemeta($_).'"'} @_); } if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { @@ -95,8 +166,7 @@ if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) { if (!$ENV{PERL_BUILD_EXPAND_ENV_VARS}) { my $dl_library_path = dquoted_comma_list(@dl_library_path); print OUT <> + # Can dynaload, but cannot dynaload Perl modules... + die 'Dynaloaded Perl modules are not available in this build of Perl' if $OS2::is_static; + + <> my @modparts = split(/::/,$module); my $modfname = $modparts[-1]; @@ -221,29 +305,39 @@ sub bootstrap { # It may also edit @modparts if required. $modfname = &mod2fname(\@modparts) if defined &mod2fname; - my $modpname = join(($Is_MacOS ? ':' : '/'),@modparts); + <<$^O-eq-NetWare>> + # Truncate the module name to 8.3 format for NetWare + if ((length($modfname) > 8)) { + $modfname = substr($modfname, 0, 8); + } + <> + + my $modpname = join(<<$^O-eq-MacOS>>':'<<|$^O-eq-MacOS>>'/'<>,@modparts); print STDERR "DynaLoader::bootstrap for $module ", - ($Is_MacOS - ? "(:auto:$modpname:$modfname.$dl_dlext)\n" : - "(auto/$modpname/$modfname.$dl_dlext)\n") + <<$^O-eq-MacOS>> "(:auto:$modpname:$modfname.$dl_dlext)\n" + <<|$^O-eq-MacOS>>"(auto/$modpname/$modfname.$dl_dlext)\n"<> if $dl_debug; foreach (@INC) { - chop($_ = VMS::Filespec::unixpath($_)) if $Is_VMS; - my $dir; - if ($Is_MacOS) { - chop $_ if /:$/; - $dir = "$_:auto:$modpname"; - } else { - $dir = "$_/auto/$modpname"; - } + <<$^O-eq-VMS>>chop($_ = VMS::Filespec::unixpath($_));<> + <<$^O-eq-MacOS>> + my $path = $_; + if ($Mac_FS && ! -d $path) { + $path = Mac::FileSpec::Unixish::nativize($path); + } + $path .= ":" unless /:$/; + my $dir = "${path}auto:$modpname"; + <<|$^O-eq-MacOS>> + my $dir = "$_/auto/$modpname"; + <> + next unless -d $dir; # skip over uninteresting directories - + # check for common cases to avoid autoload of dl_findfile - my $try = $Is_MacOS ? "$dir:$modfname.$dl_dlext" : "$dir/$modfname.$dl_dlext"; - last if $file = ($do_expand) ? dl_expandspec($try) : (-f $try && $try); - + my $try = <<$^O-eq-MacOS>> "$dir:$modfname.$dl_dlext" <<|$^O-eq-MacOS>> "$dir/$modfname.$dl_dlext"<>; + last if $file = ($do_expand) ? dl_expandspec($try) : ((-f $try) && $try); + # no luck here, save dir for possible later dl_findfile search push @dirs, $dir; } @@ -253,7 +347,7 @@ sub bootstrap { croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)") unless $file; # wording similar to error from 'require' - $file = uc($file) if $Is_VMS && $Config{d_vms_case_sensitive_symbols}; + <<$^O-eq-VMS>>$file = uc($file) if $Config::Config{d_vms_case_sensitive_symbols};<> my $bootname = "boot_$module"; $bootname =~ s/\W/_/g; @dl_require_symbols = ($bootname); @@ -269,6 +363,14 @@ sub bootstrap { warn "$bs: $@\n" if $@; } + my $boot_symbol_ref; + + <<$^O-eq-darwin>> + if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) { + goto boot; #extension library has already been loaded, e.g. darwin + } + <> + # Many dynamic extension loading problems will appear to come from # this section of code: XYZ failed at line 123 of DynaLoader.pm. # Often these errors are actually occurring in the initialisation @@ -287,14 +389,18 @@ sub bootstrap { Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); } - my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or + $boot_symbol_ref = dl_find_symbol($libref, $bootname) or croak("Can't find '$bootname' symbol in $file\n"); - my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); - push(@dl_modules, $module); # record loaded module + boot: + my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); + # See comment block above + + push(@dl_shared_objects, $file); # record files loaded + &$xs(@args); } @@ -318,42 +424,40 @@ sub dl_findfile { my (@args) = @_; my (@dirs, $dir); # which directories to search my (@found); # full paths to real files we have found -EOT - -print OUT ' my $dl_ext= ' . to_string($Config::Config{'dlext'}) . - "; # \$Config::Config{'dlext'} suffix for perl extensions\n"; -print OUT ' my $dl_so = ' . to_string($Config::Config{'so'}) . - "; # \$Config::Config{'so'} suffix for shared libraries\n"; - -print OUT <<'EOT'; + #my $dl_ext= <<=to_string($Config::Config{'dlext'})>>; # $Config::Config{'dlext'} suffix for perl extensions + #my $dl_so = <<=to_string($Config::Config{'so'})>>; # $Config::Config{'so'} suffix for shared libraries print STDERR "dl_findfile(@args)\n" if $dl_debug; # accumulate directories but process files as they appear arg: foreach(@args) { # Special fast case: full filepath requires no search - if ($Is_VMS && m%[:>/\]]% && -f $_) { + <<$^O-eq-VMS>> + if (m%[:>/\]]% && -f $_) { push(@found,dl_expandspec(VMS::Filespec::vmsify($_))); last arg unless wantarray; next; } - elsif ($Is_MacOS) { + <> + <<$^O-eq-MacOS>> if (m/:/ && -f $_) { push(@found,$_); last arg unless wantarray; } - } - elsif (m:/: && -f $_ && !$do_expand) { + <> + <<$^O-ne-VMS>> + if (m:/: && -f $_) { push(@found,$_); last arg unless wantarray; next; } + <> # Deal with directories first: # Using a -L prefix is the preferred option (faster and more robust) if (m:^-L:) { s/^-L//; push(@dirs, $_); next; } - if ($Is_MacOS) { + <<$^O-eq-MacOS>> # Otherwise we try to try to spot directories by a heuristic # (this is a more complicated issue than it first appears) if (m/:/ && -d $_) { push(@dirs, $_); next; } @@ -375,15 +479,17 @@ print OUT <<'EOT'; } } next; - } + <> # Otherwise we try to try to spot directories by a heuristic # (this is a more complicated issue than it first appears) if (m:/: && -d $_) { push(@dirs, $_); next; } - # VMS: we may be using native VMS directry syntax instead of + <<$^O-eq-VMS>> + # VMS: we may be using native VMS directory syntax instead of # Unix emulation, so check this as well - if ($Is_VMS && /[:>\]]/ && -d $_) { push(@dirs, $_); next; } + if (/[:>\]]/ && -d $_) { push(@dirs, $_); next; } + <> # Only files should get this far... my(@names, $name); # what filenames to look for @@ -393,17 +499,28 @@ print OUT <<'EOT'; push(@names,"lib$_.a"); } else { # Umm, a bare name. Try various alternatives: # these should be ordered with the most likely first - push(@names,"$_.$dl_ext") unless m/\.$dl_ext$/o; + push(@names,"$_.$dl_dlext") unless m/\.$dl_dlext$/o; push(@names,"$_.$dl_so") unless m/\.$dl_so$/o; push(@names,"lib$_.$dl_so") unless m:/:; push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs"; push(@names, $_); } + my $dirsep = '/'; + <<$^O-eq-symbian>> + $dirsep = '\\'; + if ($0 =~ /^([a-z]):/i) { + my $drive = $1; + @dirs = map { "$drive:$_" } @dirs; + @dl_library_path = map { "$drive:$_" } @dl_library_path; + } + <> foreach $dir (@dirs, @dl_library_path) { next unless -d $dir; - chop($dir = VMS::Filespec::unixpath($dir)) if $Is_VMS; + <<$^O-eq-VMS>> + chop($dir = VMS::Filespec::unixpath($dir)); + <> foreach $name (@names) { - my($file) = "$dir/$name"; + my($file) = "$dir$dirsep$name"; print STDERR " checking in $dir for $name\n" if $dl_debug; $file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file); #$file = _check_file($file); @@ -441,12 +558,13 @@ sub dl_expandspec { my $file = $spec; # default output to input - if ($Is_VMS) { # dl_expandspec should be defined in dl_vms.xs + <<$^O-eq-VMS>> + # dl_expandspec should be defined in dl_vms.xs require Carp; Carp::croak("dl_expandspec: should be defined in XS file!\n"); - } else { + <<|$^O-eq-VMS>> return undef unless -f $file; - } + <> print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug; $file; } @@ -466,8 +584,6 @@ sub dl_find_symbol_anywhere DynaLoader - Dynamically load C libraries into Perl code -dl_error(), dl_findfile(), dl_expandspec(), dl_load_file(), dl_unload_file(), dl_find_symbol(), dl_find_symbol_anywhere(), dl_undef_symbols(), dl_install_xsub(), dl_load_flags(), bootstrap() - routines used by DynaLoader modules - =head1 SYNOPSIS package YourPackage; @@ -501,7 +617,9 @@ useless for accessing non-Perl libraries because it provides almost no Perl-to-C 'glue'. There is, for example, no mechanism for calling a C library function or supplying arguments. A C::DynaLib module is available from CPAN sites which performs that function for some -common system types. +common system types. And since the year 2000, there's also Inline::C, +a module that allows you to write Perl subroutines in C. Also available +from your local CPAN site. DynaLoader Interface Summary @@ -511,6 +629,7 @@ DynaLoader Interface Summary $dl_debug @dl_librefs @dl_modules + @dl_shared_objects Implemented in: bootstrap($modulename) Perl @filepaths = dl_findfile(@names) Perl @@ -586,6 +705,10 @@ the loaded files. An array of module (package) names that have been bootstrap'ed. +=item @dl_shared_objects + +An array of file names for the shared objects that were loaded. + =item dl_error() Syntax: @@ -732,11 +855,11 @@ Apache and mod_perl built with the APXS mechanism. Linux, and is a common choice when providing a "wrapper" on other mechanisms as is done in the OS/2 port.) -=item dl_loadflags() +=item dl_load_flags() Syntax: - $flags = dl_loadflags $modulename; + $flags = dl_load_flags $modulename; Designed to be a method call, and to be overridden by a derived class (i.e. a class which has DynaLoader in its @ISA). The definition in