1:
2:
3:
4: package DynaLoader;
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23: require Carp;
24:
25: BEGIN {
26: $VERSION = '1.09';
27: }
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44: BEGIN {
45: $XS_VERSION = '1.05';
46: }
47:
48: require AutoLoader;
49: *AUTOLOAD = \&AutoLoader::AUTOLOAD;
50:
51: use Config;
52:
53:
54: $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67: sub dl_load_flags { 0x00 }
68:
69: ($dl_dlext, $dl_so, $dlsrc) = @Config::Config{qw(dlext so dlsrc)};
70:
71:
72: $do_expand = 0;
73:
74:
75:
76: @dl_require_symbols = ();
77: @dl_resolve_using = ();
78: @dl_library_path = ();
79:
80:
81:
82:
83:
84:
85:
86: @dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs";
87:
88:
89:
90:
91: push(@dl_library_path, split(' ', $Config::Config{libpth}));
92:
93:
94: my $ldlibpthname = $Config::Config{ldlibpthname};
95: my $ldlibpthname_defined = defined $Config::Config{ldlibpthname};
96: my $pthsep = $Config::Config{path_sep};
97:
98:
99:
100:
101: if ($ldlibpthname_defined &&
102: exists $ENV{$ldlibpthname}) {
103: push(@dl_library_path, split(/$pthsep/, $ENV{$ldlibpthname}));
104: }
105:
106:
107:
108: if ($ldlibpthname_defined &&
109: $ldlibpthname ne 'LD_LIBRARY_PATH' &&
110: exists $ENV{LD_LIBRARY_PATH}) {
111: push(@dl_library_path, split(/$pthsep/, $ENV{LD_LIBRARY_PATH}));
112: }
113:
114:
115:
116:
117: boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
118: !defined(&dl_error);
119:
120: if ($dl_debug) {
121: print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n";
122: print STDERR "DynaLoader not linked into this perl\n"
123: unless defined(&boot_DynaLoader);
124: }
125:
126: 1;
127:
128:
129: sub croak { require Carp; Carp::croak(@_) }
130:
131: sub bootstrap_inherit {
132: my $module = $_[0];
133: local *isa = *{"$module\::ISA"};
134: local @isa = (@isa, 'DynaLoader');
135:
136: bootstrap(@_);
137: }
138:
139:
140:
141:
142: sub bootstrap {
143:
144: local(@args) = @_;
145: local($module) = $args[0];
146: local(@dirs, $file);
147:
148: unless ($module) {
149: require Carp;
150: Carp::confess("Usage: DynaLoader::bootstrap(module)");
151: }
152:
153:
154:
155: croak("Can't load module $module, dynamic loading not available in this perl.\n".
156: " (You may need to build a new perl executable which either supports\n".
157: " dynamic loading or has the $module module statically linked into it.)\n")
158: unless defined(&dl_load_file);
159:
160:
161:
162: my @modparts = split(/::/,$module);
163: my $modfname = $modparts[-1];
164:
165:
166:
167:
168: $modfname = &mod2fname(\@modparts) if defined &mod2fname;
169:
170:
171:
172: my $modpname = join('/',@modparts);
173:
174: print STDERR "DynaLoader::bootstrap for $module ",
175: "(auto/$modpname/$modfname.$dl_dlext)\n"
176: if $dl_debug;
177:
178: foreach (@INC) {
179:
180:
181: my $dir = "$_/auto/$modpname";
182:
183:
184: next unless -d $dir;
185:
186:
187: my $try = "$dir/$modfname.$dl_dlext";
188: last if $file = ($do_expand) ? dl_expandspec($try) : ((-f $try) && $try);
189:
190:
191: push @dirs, $dir;
192: }
193:
194: $file = dl_findfile(map("-L$_",@dirs,@INC), $modfname) unless $file;
195:
196: croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)")
197: unless $file;
198:
199:
200: my $bootname = "boot_$module";
201: $bootname =~ s/\W/_/g;
202: @dl_require_symbols = ($bootname);
203:
204:
205:
206:
207: my $bs = $file;
208: $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/;
209: if (-s $bs) {
210: print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;
211: eval { do $bs; };
212: warn "$bs: $@\n" if $@;
213: }
214:
215: my $boot_symbol_ref;
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226: my $libref = dl_load_file($file, $module->dl_load_flags) or
227: croak("Can't load '$file' for module $module: ".dl_error());
228:
229: push(@dl_librefs,$libref);
230:
231: my @unresolved = dl_undef_symbols();
232: if (@unresolved) {
233: require Carp;
234: Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
235: }
236:
237: $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
238: croak("Can't find '$bootname' symbol in $file\n");
239:
240: push(@dl_modules, $module);
241:
242: boot:
243: my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
244:
245:
246:
247: push(@dl_shared_objects, $file);
248:
249: &$xs(@args);
250: }
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262: __END__
263:
264:
265: sub dl_findfile {
266: # Read ext/DynaLoader/DynaLoader.doc for detailed information.
267: # This function does not automatically consider the architecture
268: # or the perl library auto directories.
269: my (@args) = @_;
270: my (@dirs, $dir); # which directories to search
271: my (@found); # full paths to real files we have found
272: #my $dl_ext= 'so'; # $Config::Config{'dlext'} suffix for perl extensions
273: #my $dl_so = 'so'; # $Config::Config{'so'} suffix for shared libraries
274:
275: print STDERR "dl_findfile(@args)\n" if $dl_debug;
276:
277: # accumulate directories but process files as they appear
278: arg: foreach(@args) {
279: # Special fast case: full filepath requires no search
280:
281:
282:
283: if (m:/: && -f $_) {
284: push(@found,$_);
285: last arg unless wantarray;
286: next;
287: }
288:
289:
290: # Deal with directories first:
291: # Using a -L prefix is the preferred option (faster and more robust)
292: if (m:^-L:) { s/^-L//; push(@dirs, $_); next; }
293:
294:
295:
296: # Otherwise we try to try to spot directories by a heuristic
297: # (this is a more complicated issue than it first appears)
298: if (m:/: && -d $_) { push(@dirs, $_); next; }
299:
300:
301:
302: # Only files should get this far...
303: my(@names, $name); # what filenames to look for
304: if (m:-l: ) { # convert -lname to appropriate library name
305: s/-l//;
306: push(@names,"lib$_.$dl_so");
307: push(@names,"lib$_.a");
308: } else { # Umm, a bare name. Try various alternatives:
309: # these should be ordered with the most likely first
310: push(@names,"$_.$dl_dlext") unless m/\.$dl_dlext$/o;
311: push(@names,"$_.$dl_so") unless m/\.$dl_so$/o;
312: push(@names,"lib$_.$dl_so") unless m:/:;
313: push(@names,"$_.a") if !m/\.a$/ and $dlsrc eq "dl_dld.xs";
314: push(@names, $_);
315: }
316: my $dirsep = '/';
317:
318: foreach $dir (@dirs, @dl_library_path) {
319: next unless -d $dir;
320:
321: foreach $name (@names) {
322: my($file) = "$dir$dirsep$name";
323: print STDERR " checking in $dir for $name\n" if $dl_debug;
324: $file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file);
325: #$file = _check_file($file);
326: if ($file) {
327: push(@found, $file);
328: next arg; # no need to look any further
329: }
330: }
331: }
332: }
333: if ($dl_debug) {
334: foreach(@dirs) {
335: print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
336: }
337: print STDERR "dl_findfile found: @found\n";
338: }
339: return $found[0] unless wantarray;
340: @found;
341: }
342:
343:
344: sub dl_expandspec {
345: my($spec) = @_;
346: # Optional function invoked if DynaLoader.pm sets $do_expand.
347: # Most systems do not require or use this function.
348: # Some systems may implement it in the dl_*.xs file in which case
349: # this autoload version will not be called but is harmless.
350:
351: # This function is designed to deal with systems which treat some
352: # 'filenames' in a special way. For example VMS 'Logical Names'
353: # (something like unix environment variables - but different).
354: # This function should recognise such names and expand them into
355: # full file paths.
356: # Must return undef if $spec is invalid or file does not exist.
357:
358: my $file = $spec; # default output to input
359:
360:
361: return undef unless -f $file;
362:
363: print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
364: $file;
365: }
366:
367: sub dl_find_symbol_anywhere
368: {
369: my $sym = shift;
370: my $libref;
371: foreach $libref (@dl_librefs) {
372: my $symref = dl_find_symbol($libref,$sym);
373: return $symref if $symref;
374: }
375: return undef;
376: }
377:
378: =head1 NAME
379:
380: DynaLoader - Dynamically load C libraries into Perl code
381:
382: =head1 SYNOPSIS
383:
384: package YourPackage;
385: require DynaLoader;
386: @ISA = qw(... DynaLoader ...);
387: bootstrap YourPackage;
388:
389: # optional method for 'global' loading
390: sub dl_load_flags { 0x01 }
391:
392:
393: =head1 DESCRIPTION
394:
395: This document defines a standard generic interface to the dynamic
396: linking mechanisms available on many platforms. Its primary purpose is
397: to implement automatic dynamic loading of Perl modules.
398:
399: This document serves as both a specification for anyone wishing to
400: implement the DynaLoader for a new platform and as a guide for
401: anyone wishing to use the DynaLoader directly in an application.
402:
403: The DynaLoader is designed to be a very simple high-level
404: interface that is sufficiently general to cover the requirements
405: of SunOS, HP-UX, NeXT, Linux, VMS and other platforms.
406:
407: It is also hoped that the interface will cover the needs of OS/2, NT
408: etc and also allow pseudo-dynamic linking (using C<ld -A> at runtime).
409:
410: It must be stressed that the DynaLoader, by itself, is practically
411: useless for accessing non-Perl libraries because it provides almost no
412: Perl-to-C 'glue'. There is, for example, no mechanism for calling a C
413: library function or supplying arguments. A C::DynaLib module
414: is available from CPAN sites which performs that function for some
415: common system types. And since the year 2000, there's also Inline::C,
416: a module that allows you to write Perl subroutines in C. Also available
417: from your local CPAN site.
418:
419: DynaLoader Interface Summary
420:
421: @dl_library_path
422: @dl_resolve_using
423: @dl_require_symbols
424: $dl_debug
425: @dl_librefs
426: @dl_modules
427: @dl_shared_objects
428: Implemented in:
429: bootstrap($modulename) Perl
430: @filepaths = dl_findfile(@names) Perl
431: $flags = $modulename->dl_load_flags Perl
432: $symref = dl_find_symbol_anywhere($symbol) Perl
433:
434: $libref = dl_load_file($filename, $flags) C
435: $status = dl_unload_file($libref) C
436: $symref = dl_find_symbol($libref, $symbol) C
437: @symbols = dl_undef_symbols() C
438: dl_install_xsub($name, $symref [, $filename]) C
439: $message = dl_error C
440:
441: =over 4
442:
443: =item @dl_library_path
444:
445: The standard/default list of directories in which dl_findfile() will
446: search for libraries etc. Directories are searched in order:
447: $dl_library_path[0], [1], ... etc
448:
449: @dl_library_path is initialised to hold the list of 'normal' directories
450: (F</usr/lib>, etc) determined by B<Configure> (C<$Config{'libpth'}>). This should
451: ensure portability across a wide range of platforms.
452:
453: @dl_library_path should also be initialised with any other directories
454: that can be determined from the environment at runtime (such as
455: LD_LIBRARY_PATH for SunOS).
456:
457: After initialisation @dl_library_path can be manipulated by an
458: application using push and unshift before calling dl_findfile().
459: Unshift can be used to add directories to the front of the search order
460: either to save search time or to override libraries with the same name
461: in the 'normal' directories.
462:
463: The load function that dl_load_file() calls may require an absolute
464: pathname. The dl_findfile() function and @dl_library_path can be
465: used to search for and return the absolute pathname for the
466: library/object that you wish to load.
467:
468: =item @dl_resolve_using
469:
470: A list of additional libraries or other shared objects which can be
471: used to resolve any undefined symbols that might be generated by a
472: later call to load_file().
473:
474: This is only required on some platforms which do not handle dependent
475: libraries automatically. For example the Socket Perl extension
476: library (F<auto/Socket/Socket.so>) contains references to many socket
477: functions which need to be resolved when it's loaded. Most platforms
478: will automatically know where to find the 'dependent' library (e.g.,
479: F</usr/lib/libsocket.so>). A few platforms need to be told the
480: location of the dependent library explicitly. Use @dl_resolve_using
481: for this.
482:
483: Example usage:
484:
485: @dl_resolve_using = dl_findfile('-lsocket');
486:
487: =item @dl_require_symbols
488:
489: A list of one or more symbol names that are in the library/object file
490: to be dynamically loaded. This is only required on some platforms.
491:
492: =item @dl_librefs
493:
494: An array of the handles returned by successful calls to dl_load_file(),
495: made by bootstrap, in the order in which they were loaded.
496: Can be used with dl_find_symbol() to look for a symbol in any of
497: the loaded files.
498:
499: =item @dl_modules
500:
501: An array of module (package) names that have been bootstrap'ed.
502:
503: =item @dl_shared_objects
504:
505: An array of file names for the shared objects that were loaded.
506:
507: =item dl_error()
508:
509: Syntax:
510:
511: $message = dl_error();
512:
513: Error message text from the last failed DynaLoader function. Note
514: that, similar to errno in unix, a successful function call does not
515: reset this message.
516:
517: Implementations should detect the error as soon as it occurs in any of
518: the other functions and save the corresponding message for later
519: retrieval. This will avoid problems on some platforms (such as SunOS)
520: where the error message is very temporary (e.g., dlerror()).
521:
522: =item $dl_debug
523:
524: Internal debugging messages are enabled when $dl_debug is set true.
525: Currently setting $dl_debug only affects the Perl side of the
526: DynaLoader. These messages should help an application developer to
527: resolve any DynaLoader usage problems.
528:
529: $dl_debug is set to C<$ENV{'PERL_DL_DEBUG'}> if defined.
530:
531: For the DynaLoader developer/porter there is a similar debugging
532: variable added to the C code (see dlutils.c) and enabled if Perl was
533: built with the B<-DDEBUGGING> flag. This can also be set via the
534: PERL_DL_DEBUG environment variable. Set to 1 for minimal information or
535: higher for more.
536:
537: =item dl_findfile()
538:
539: Syntax:
540:
541: @filepaths = dl_findfile(@names)
542:
543: Determine the full paths (including file suffix) of one or more
544: loadable files given their generic names and optionally one or more
545: directories. Searches directories in @dl_library_path by default and
546: returns an empty list if no files were found.
547:
548: Names can be specified in a variety of platform independent forms. Any
549: names in the form B<-lname> are converted into F<libname.*>, where F<.*> is
550: an appropriate suffix for the platform.
551:
552: If a name does not already have a suitable prefix and/or suffix then
553: the corresponding file will be searched for by trying combinations of
554: prefix and suffix appropriate to the platform: "$name.o", "lib$name.*"
555: and "$name".
556:
557: If any directories are included in @names they are searched before
558: @dl_library_path. Directories may be specified as B<-Ldir>. Any other
559: names are treated as filenames to be searched for.
560:
561: Using arguments of the form C<-Ldir> and C<-lname> is recommended.
562:
563: Example:
564:
565: @dl_resolve_using = dl_findfile(qw(-L/usr/5lib -lposix));
566:
567:
568: =item dl_expandspec()
569:
570: Syntax:
571:
572: $filepath = dl_expandspec($spec)
573:
574: Some unusual systems, such as VMS, require special filename handling in
575: order to deal with symbolic names for files (i.e., VMS's Logical Names).
576:
577: To support these systems a dl_expandspec() function can be implemented
578: either in the F<dl_*.xs> file or code can be added to the autoloadable
579: dl_expandspec() function in F<DynaLoader.pm>. See F<DynaLoader.pm> for
580: more information.
581:
582: =item dl_load_file()
583:
584: Syntax:
585:
586: $libref = dl_load_file($filename, $flags)
587:
588: Dynamically load $filename, which must be the path to a shared object
589: or library. An opaque 'library reference' is returned as a handle for
590: the loaded object. Returns undef on error.
591:
592: The $flags argument to alters dl_load_file behaviour.
593: Assigned bits:
594:
595: 0x01 make symbols available for linking later dl_load_file's.
596: (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL))
597: (ignored under VMS; this is a normal part of image linking)
598:
599: (On systems that provide a handle for the loaded object such as SunOS
600: and HPUX, $libref will be that handle. On other systems $libref will
601: typically be $filename or a pointer to a buffer containing $filename.
602: The application should not examine or alter $libref in any way.)
603:
604: This is the function that does the real work. It should use the
605: current values of @dl_require_symbols and @dl_resolve_using if required.
606:
607: SunOS: dlopen($filename)
608: HP-UX: shl_load($filename)
609: Linux: dld_create_reference(@dl_require_symbols); dld_link($filename)
610: NeXT: rld_load($filename, @dl_resolve_using)
611: VMS: lib$find_image_symbol($filename,$dl_require_symbols[0])
612:
613: (The dlopen() function is also used by Solaris and some versions of
614: Linux, and is a common choice when providing a "wrapper" on other
615: mechanisms as is done in the OS/2 port.)
616:
617: =item dl_unload_file()
618:
619: Syntax:
620:
621: $status = dl_unload_file($libref)
622:
623: Dynamically unload $libref, which must be an opaque 'library reference' as
624: returned from dl_load_file. Returns one on success and zero on failure.
625:
626: This function is optional and may not necessarily be provided on all platforms.
627: If it is defined, it is called automatically when the interpreter exits for
628: every shared object or library loaded by DynaLoader::bootstrap. All such
629: library references are stored in @dl_librefs by DynaLoader::Bootstrap as it
630: loads the libraries. The files are unloaded in last-in, first-out order.
631:
632: This unloading is usually necessary when embedding a shared-object perl (e.g.
633: one configured with -Duseshrplib) within a larger application, and the perl
634: interpreter is created and destroyed several times within the lifetime of the
635: application. In this case it is possible that the system dynamic linker will
636: unload and then subsequently reload the shared libperl without relocating any
637: references to it from any files DynaLoaded by the previous incarnation of the
638: interpreter. As a result, any shared objects opened by DynaLoader may point to
639: a now invalid 'ghost' of the libperl shared object, causing apparently random
640: memory corruption and crashes. This behaviour is most commonly seen when using
641: Apache and mod_perl built with the APXS mechanism.
642:
643: SunOS: dlclose($libref)
644: HP-UX: ???
645: Linux: ???
646: NeXT: ???
647: VMS: ???
648:
649: (The dlclose() function is also used by Solaris and some versions of
650: Linux, and is a common choice when providing a "wrapper" on other
651: mechanisms as is done in the OS/2 port.)
652:
653: =item dl_load_flags()
654:
655: Syntax:
656:
657: $flags = dl_load_flags $modulename;
658:
659: Designed to be a method call, and to be overridden by a derived class
660: (i.e. a class which has DynaLoader in its @ISA). The definition in
661: DynaLoader itself returns 0, which produces standard behavior from
662: dl_load_file().
663:
664: =item dl_find_symbol()
665:
666: Syntax:
667:
668: $symref = dl_find_symbol($libref, $symbol)
669:
670: Return the address of the symbol $symbol or C<undef> if not found. If the
671: target system has separate functions to search for symbols of different
672: types then dl_find_symbol() should search for function symbols first and
673: then other types.
674:
675: The exact manner in which the address is returned in $symref is not
676: currently defined. The only initial requirement is that $symref can
677: be passed to, and understood by, dl_install_xsub().
678:
679: SunOS: dlsym($libref, $symbol)
680: HP-UX: shl_findsym($libref, $symbol)
681: Linux: dld_get_func($symbol) and/or dld_get_symbol($symbol)
682: NeXT: rld_lookup("_$symbol")
683: VMS: lib$find_image_symbol($libref,$symbol)
684:
685:
686: =item dl_find_symbol_anywhere()
687:
688: Syntax:
689:
690: $symref = dl_find_symbol_anywhere($symbol)
691:
692: Applies dl_find_symbol() to the members of @dl_librefs and returns
693: the first match found.
694:
695: =item dl_undef_symbols()
696:
697: Example
698:
699: @symbols = dl_undef_symbols()
700:
701: Return a list of symbol names which remain undefined after load_file().
702: Returns C<()> if not known. Don't worry if your platform does not provide
703: a mechanism for this. Most do not need it and hence do not provide it,
704: they just return an empty list.
705:
706:
707: =item dl_install_xsub()
708:
709: Syntax:
710:
711: dl_install_xsub($perl_name, $symref [, $filename])
712:
713: Create a new Perl external subroutine named $perl_name using $symref as
714: a pointer to the function which implements the routine. This is simply
715: a direct call to newXSUB(). Returns a reference to the installed
716: function.
717:
718: The $filename parameter is used by Perl to identify the source file for
719: the function if required by die(), caller() or the debugger. If
720: $filename is not defined then "DynaLoader" will be used.
721:
722:
723: =item bootstrap()
724:
725: Syntax:
726:
727: bootstrap($module)
728:
729: This is the normal entry point for automatic dynamic loading in Perl.
730:
731: It performs the following actions:
732:
733: =over 8
734:
735: =item *
736:
737: locates an auto/$module directory by searching @INC
738:
739: =item *
740:
741: uses dl_findfile() to determine the filename to load
742:
743: =item *
744:
745: sets @dl_require_symbols to C<("boot_$module")>
746:
747: =item *
748:
749: executes an F<auto/$module/$module.bs> file if it exists
750: (typically used to add to @dl_resolve_using any files which
751: are required to load the module on the current platform)
752:
753: =item *
754:
755: calls dl_load_flags() to determine how to load the file.
756:
757: =item *
758:
759: calls dl_load_file() to load the file
760:
761: =item *
762:
763: calls dl_undef_symbols() and warns if any symbols are undefined
764:
765: =item *
766:
767: calls dl_find_symbol() for "boot_$module"
768:
769: =item *
770:
771: calls dl_install_xsub() to install it as "${module}::bootstrap"
772:
773: =item *
774:
775: calls &{"${module}::bootstrap"} to bootstrap the module (actually
776: it uses the function reference returned by dl_install_xsub for speed)
777:
778: =back
779:
780: =back
781:
782:
783: =head1 AUTHOR
784:
785: Tim Bunce, 11 August 1994.
786:
787: This interface is based on the work and comments of (in no particular
788: order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno
789: Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, myself and others.
790:
791: Larry Wall designed the elegant inherited bootstrap mechanism and
792: implemented the first Perl 5 dynamic loader using it.
793:
794: Solaris global loading added by Nick Ing-Simmons with design/coding
795: assistance from Tim Bunce, January 1996.
796:
797: =cut