Commit | Line | Data |
---|---|---|
9cf41c4d GS |
1 | use Config; |
2 | ||
3 | sub to_string { | |
4 | my ($value) = @_; | |
5 | $value =~ s/\\/\\\\/g; | |
6 | $value =~ s/'/\\'/g; | |
7 | return "'$value'"; | |
8 | } | |
9 | ||
10 | unlink "XSLoader.pm" if -f "XSLoader.pm"; | |
11 | open OUT, ">XSLoader.pm" or die $!; | |
12 | print OUT <<'EOT'; | |
13 | # Generated from XSLoader.pm.PL (resolved %Config::Config value) | |
14 | ||
15 | package XSLoader; | |
16 | ||
17 | # And Gandalf said: 'Many folk like to know beforehand what is to | |
18 | # be set on the table; but those who have laboured to prepare the | |
19 | # feast like to keep their secret; for wonder makes the words of | |
20 | # praise louder.' | |
21 | ||
22 | # (Quote from Tolkien sugested by Anno Siegel.) | |
23 | # | |
24 | # See pod text at end of file for documentation. | |
25 | # See also ext/DynaLoader/README in source tree for other information. | |
26 | # | |
27 | # Tim.Bunce@ig.co.uk, August 1994 | |
28 | ||
29 | $VERSION = "0.01"; # avoid typo warning | |
30 | ||
31 | # enable debug/trace messages from DynaLoader perl code | |
32 | # $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; | |
33 | ||
34 | EOT | |
35 | ||
36 | print OUT ' my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ; | |
37 | ||
38 | print OUT <<'EOT'; | |
39 | ||
9cf41c4d | 40 | package DynaLoader; |
b4cea227 GS |
41 | |
42 | # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. | |
43 | # NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB | |
9cf41c4d | 44 | boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && |
b4cea227 | 45 | !defined(&dl_error); |
9cf41c4d GS |
46 | package XSLoader; |
47 | ||
48 | 1; # End of main code | |
49 | ||
50 | # The bootstrap function cannot be autoloaded (without complications) | |
51 | # so we define it here: | |
52 | ||
53 | sub load { | |
54 | package DynaLoader; | |
55 | ||
56 | my($module) = $_[0]; | |
57 | ||
58 | # work with static linking too | |
59 | my $b = "$module\::bootstrap"; | |
60 | goto &$b if defined &$b; | |
61 | ||
62 | goto retry unless $module and defined &dl_load_file; | |
63 | ||
64 | my @modparts = split(/::/,$module); | |
65 | my $modfname = $modparts[-1]; | |
66 | ||
67 | EOT | |
68 | ||
69 | print OUT <<'EOT' if defined &DynaLoader::mod2fname; | |
70 | # Some systems have restrictions on files names for DLL's etc. | |
71 | # mod2fname returns appropriate file base name (typically truncated) | |
72 | # It may also edit @modparts if required. | |
73 | $modfname = &mod2fname(\@modparts) if defined &mod2fname; | |
74 | ||
75 | EOT | |
76 | ||
77 | print OUT <<'EOT'; | |
78 | my $modpname = join('/',@modparts); | |
79 | my $modlibname = (caller())[1]; | |
80 | my $c = @modparts; | |
81 | $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename | |
82 | my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext"; | |
83 | ||
84 | # print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug; | |
85 | ||
86 | my $bs = $file; | |
87 | $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library | |
88 | ||
89 | goto retry if not -f $file or -s $bs; | |
90 | ||
91 | my $bootname = "boot_$module"; | |
92 | $bootname =~ s/\W/_/g; | |
93 | @dl_require_symbols = ($bootname); | |
94 | ||
95 | # Many dynamic extension loading problems will appear to come from | |
96 | # this section of code: XYZ failed at line 123 of DynaLoader.pm. | |
97 | # Often these errors are actually occurring in the initialisation | |
98 | # C code of the extension XS file. Perl reports the error as being | |
99 | # in this perl code simply because this was the last perl code | |
100 | # it executed. | |
101 | ||
102 | my $libref = dl_load_file($file, 0) or do { | |
103 | require Carp; | |
104 | Carp::croak("Can't load '$file' for module $module: " . dl_error()); | |
105 | }; | |
106 | push(@dl_librefs,$libref); # record loaded object | |
107 | ||
108 | my @unresolved = dl_undef_symbols(); | |
109 | if (@unresolved) { | |
110 | require Carp; | |
111 | Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); | |
112 | } | |
113 | ||
114 | my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do { | |
115 | require Carp; | |
116 | Carp::croak("Can't find '$bootname' symbol in $file\n"); | |
117 | }; | |
118 | ||
119 | my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); | |
120 | ||
121 | push(@dl_modules, $module); # record loaded module | |
122 | ||
123 | # See comment block above | |
124 | return &$xs(@_); | |
125 | ||
126 | retry: | |
127 | require DynaLoader; | |
128 | goto &DynaLoader::bootstrap_inherit; | |
129 | } | |
130 | ||
131 | __END__ | |
132 | ||
133 | =head1 NAME | |
134 | ||
135 | XSLoader - Dynamically load C libraries into Perl code | |
136 | ||
137 | =head1 SYNOPSIS | |
138 | ||
139 | package YourPackage; | |
140 | use XSLoader; | |
141 | ||
142 | XSLoader::load 'YourPackage', @args; | |
143 | ||
144 | =head1 DESCRIPTION | |
145 | ||
146 | This module defines a standard I<simplified> interface to the dynamic | |
147 | linking mechanisms available on many platforms. Its primary purpose is | |
148 | to implement cheap automatic dynamic loading of Perl modules. | |
149 | ||
150 | For more complicated interface see L<DynaLoader>. | |
151 | ||
152 | =head1 AUTHOR | |
153 | ||
154 | Ilya Zakharevich: extraction from DynaLoader. | |
155 | ||
156 | =cut | |
157 | EOT | |
158 | ||
159 | close OUT or die $!; | |
160 |