ext/DynaLoader/XSLoader_pm.PL

use Config;

sub to_string {
    my ($value) = @_;
    $value =~ s/\\/\\\\/g;
    $value =~ s/'/\\'/g;
    return "'$value'";
}

unlink "XSLoader.pm" if -f "XSLoader.pm";
open OUT, ">XSLoader.pm" or die $!;
print OUT <<'EOT';
# Generated from XSLoader.pm.PL (resolved %Config::Config value)

package XSLoader;

$VERSION = "0.02";

# enable debug/trace messages from DynaLoader perl code
# $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;

EOT

print OUT '  my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ;

print OUT <<'EOT';

package DynaLoader;

# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
                                !defined(&dl_error);
package XSLoader;

sub load {
    package DynaLoader;

    die q{XSLoader::load('Your::Module', $Your::Module::VERSION)} unless @_;

    my($module) = $_[0];

    # work with static linking too
    my $b = "$module\::bootstrap";
    goto &$b if defined &$b;

    goto retry unless $module and defined &dl_load_file;

    my @modparts = split(/::/,$module);
    my $modfname = $modparts[-1];

EOT

print OUT <<'EOT' if defined &DynaLoader::mod2fname;
    # Some systems have restrictions on files names for DLL's etc.
    # mod2fname returns appropriate file base name (typically truncated)
    # It may also edit @modparts if required.
    $modfname = &mod2fname(\@modparts) if defined &mod2fname;

EOT

print OUT <<'EOT';
    my $modpname = join('/',@modparts);
    my $modlibname = (caller())[1];
    my $c = @modparts;
    $modlibname =~ s,[\\/][^\\/]+$,, while $c--;        # Q&D basename
    my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";

#   print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;

    my $bs = $file;
    $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library

    goto retry if not -f $file or -s $bs;

    my $bootname = "boot_$module";
    $bootname =~ s/\W/_/g;
    @dl_require_symbols = ($bootname);

    my $boot_symbol_ref;

    if ($^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
    # C code of the extension XS file. Perl reports the error as being
    # in this perl code simply because this was the last perl code
    # it executed.

    my $libref = dl_load_file($file, 0) or do { 
        require Carp;
        Carp::croak("Can't load '$file' for module $module: " . dl_error());
    };
    push(@dl_librefs,$libref);  # record loaded object

    my @unresolved = dl_undef_symbols();
    if (@unresolved) {
        require Carp;
        Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
    }

    $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
        require Carp;
        Carp::croak("Can't find '$bootname' symbol in $file\n");
    };

    push(@dl_modules, $module); # record loaded module

  boot:
    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);

    # See comment block above
    push(@DynaLoader::dl_shared_objects, $file); # record files loaded
    return &$xs(@_);

  retry:
    require DynaLoader;
    goto &DynaLoader::bootstrap_inherit;
}

1;

__END__

=head1 NAME

XSLoader - Dynamically load C libraries into Perl code

=head1 SYNOPSIS

    package YourPackage;
    use XSLoader;

    XSLoader::load 'YourPackage', $YourPackage::VERSION;

=head1 DESCRIPTION

This module defines a standard I<simplified> interface to the dynamic
linking mechanisms available on many platforms.  Its primary purpose is
to implement cheap automatic dynamic loading of Perl modules.

For more complicated interface see L<DynaLoader>.  Many (most)
features of DynaLoader are not implemented in XSLoader, like for
example the dl_load_flags is not honored by XSLoader.

=head2 Migration from C<DynaLoader>

A typical module using L<DynaLoader|DynaLoader> starts like this:

    package YourPackage;
    require DynaLoader;

    our @ISA = qw( OnePackage OtherPackage DynaLoader );
    our $VERSION = '0.01';
    bootstrap YourPackage $VERSION;

Change this to

    package YourPackage;
    use XSLoader;

    our @ISA = qw( OnePackage OtherPackage );
    our $VERSION = '0.01';
    XSLoader::load 'YourPackage', $VERSION;

In other words: replace C<require DynaLoader> by C<use XSLoader>, remove
C<DynaLoader> from @ISA, change C<bootstrap> by C<XSLoader::load>.  Do not
forget to quote the name of your package on the C<XSLoader::load> line,
and add comma (C<,>) before the arguments ($VERSION above).

Of course, if @ISA contained only C<DynaLoader>, there is no need to have the
@ISA assignment at all; moreover, if instead of C<our> one uses
backward-compatible

    use vars qw($VERSION @ISA);

one can remove this reference to @ISA together with the @ISA assignment

If no $VERSION was specified on the C<bootstrap> line, the last line becomes

    XSLoader::load 'YourPackage';

=head2 Backward compatible boilerplate

If you want to have your cake and eat it too, you need a more complicated
boilerplate.

    package YourPackage;
    use vars qw($VERSION @ISA);

    @ISA = qw( OnePackage OtherPackage );
    $VERSION = '0.01';
    eval {
       require XSLoader;
       XSLoader::load('YourPackage', $VERSION);
       1;
    } or do {
       require DynaLoader;
       push @ISA, 'DynaLoader';
       bootstrap YourPackage $VERSION;
    };

The parentheses about XSLoader::load() arguments are needed since we replaced
C<use XSLoader> by C<require>, so the compiler does not know that a function
XSLoader::load() is present.

This boilerplate uses the low-overhead C<XSLoader> if present; if used with
an antic Perl which has no C<XSLoader>, it falls back to using C<DynaLoader>.

=head1 Order of initialization: early load()

I<Skip this section if the XSUB functions are supposed to be called from other
modules only; read it only if you call your XSUBs from the code in your module,
or have a C<BOOT:> section in your XS file (see L<perlxs/"The BOOT: Keyword">).
What is described here is equally applicable to L<DynaLoader|DynaLoader>
interface.>

A sufficiently complicated module using XS would have both Perl code (defined
in F<YourPackage.pm>) and XS code (defined in F<YourPackage.xs>).  If this
Perl code makes calls into this XS code, and/or this XS code makes calls to
the Perl code, one should be careful with the order of initialization.

The call to XSLoader::load() (or bootstrap()) has three side effects:

=over

=item *

if $VERSION was specified, a sanity check is done to insure that the versions
of the F<.pm> and the (compiled) F<.xs> parts are compatible;

=item *

The XSUBs are made accessible from Perl;

=item *

If the C<BOOT:> section was present in F<.xs> file, the code there is called.

=back

Consequently, if the code in F<.pm> file makes calls to these XSUBs, it is
convenient to have XSUBs installed before the Perl code is defined; for
example, this makes prototypes for XSUBs visible to this Perl code.
Alternatively, if the C<BOOT:> section makes calls to Perl functions (or
uses Perl variables) defined in F<.pm> file, they must be defined prior to
the call to XSLoader::load() (or bootstrap()).

The first situation being much more frequent, it makes sense to rewrite the
boilerplate as

    package YourPackage;
    use XSLoader;
    use vars qw($VERSION @ISA);

    BEGIN {
       @ISA = qw( OnePackage OtherPackage );
       $VERSION = '0.01';

       # Put Perl code used in the BOOT: section here

       XSLoader::load 'YourPackage', $VERSION;
    }

    # Put Perl code making calls into XSUBs here

=head2 The most hairy case

If the interdependence of your C<BOOT:> section and Perl code is
more complicated than this (e.g., the C<BOOT:> section makes calls to Perl
functions which make calls to XSUBs with prototypes), get rid of the C<BOOT:>
section altogether.  Replace it with a function onBOOT(), and call it like
this:

    package YourPackage;
    use XSLoader;
    use vars qw($VERSION @ISA);

    BEGIN {
       @ISA = qw( OnePackage OtherPackage );
       $VERSION = '0.01';
       XSLoader::load 'YourPackage', $VERSION;
    }

    # Put Perl code used in onBOOT() function here; calls to XSUBs are
    # prototype-checked.

    onBOOT;

    # Put Perl initialization code assuming that XS is initialized here

=head1 LIMITATIONS

To reduce the overhead as much as possible, only one possible location
is checked to find the extension DLL (this location is where C<make install>
would put the DLL).  If not found, the search for the DLL is transparently
delegated to C<DynaLoader>, which looks for the DLL along the @INC list.

In particular, this is applicable to the structure of @INC used for testing
not-yet-installed extensions.  This means that the overhead of running
uninstalled extension may be much more than running the same extension after
C<make install>.

=head1 AUTHOR

Ilya Zakharevich: extraction from DynaLoader.

=cut
EOT

close OUT or die $!;

Revision:	1.1
Committed:	Thu Jun 30 14:26:46 2005 UTC (21 years, 3 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	PERL-5-8-7, HEAD
Branch point for:	PERL
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.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			$VERSION = "0.02";
18
19			# enable debug/trace messages from DynaLoader perl code
20			# $dl_debug = $ENV{PERL_DL_DEBUG} \|\| 0 unless defined $dl_debug;
21
22			EOT
23
24			print OUT ' my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ;
25
26			print OUT <<'EOT';
27
28			package DynaLoader;
29
30			# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
31			# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
32			boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
33			!defined(&dl_error);
34			package XSLoader;
35
36			sub load {
37			package DynaLoader;
38
39			die q{XSLoader::load('Your::Module', $Your::Module::VERSION)} unless @_;
40
41			my($module) = $_[0];
42
43			# work with static linking too
44			my $b = "$module\::bootstrap";
45			goto &$b if defined &$b;
46
47			goto retry unless $module and defined &dl_load_file;
48
49			my @modparts = split(/::/,$module);
50			my $modfname = $modparts[-1];
51
52			EOT
53
54			print OUT <<'EOT' if defined &DynaLoader::mod2fname;
55			# Some systems have restrictions on files names for DLL's etc.
56			# mod2fname returns appropriate file base name (typically truncated)
57			# It may also edit @modparts if required.
58			$modfname = &mod2fname(\@modparts) if defined &mod2fname;
59
60			EOT
61
62			print OUT <<'EOT';
63			my $modpname = join('/',@modparts);
64			my $modlibname = (caller())[1];
65			my $c = @modparts;
66			$modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
67			my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";
68
69			# print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;
70
71			my $bs = $file;
72			$bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
73
74			goto retry if not -f $file or -s $bs;
75
76			my $bootname = "boot_$module";
77			$bootname =~ s/\W/_/g;
78			@dl_require_symbols = ($bootname);
79
80			my $boot_symbol_ref;
81
82			if ($^O eq 'darwin') {
83			if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) {
84			goto boot; #extension library has already been loaded, e.g. darwin
85			}
86			}
87
88			# Many dynamic extension loading problems will appear to come from
89			# this section of code: XYZ failed at line 123 of DynaLoader.pm.
90			# Often these errors are actually occurring in the initialisation
91			# C code of the extension XS file. Perl reports the error as being
92			# in this perl code simply because this was the last perl code
93			# it executed.
94
95			my $libref = dl_load_file($file, 0) or do {
96			require Carp;
97			Carp::croak("Can't load '$file' for module $module: " . dl_error());
98			};
99			push(@dl_librefs,$libref); # record loaded object
100
101			my @unresolved = dl_undef_symbols();
102			if (@unresolved) {
103			require Carp;
104			Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
105			}
106
107			$boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
108			require Carp;
109			Carp::croak("Can't find '$bootname' symbol in $file\n");
110			};
111
112			push(@dl_modules, $module); # record loaded module
113
114			boot:
115			my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
116
117			# See comment block above
118			push(@DynaLoader::dl_shared_objects, $file); # record files loaded
119			return &$xs(@_);
120
121			retry:
122			require DynaLoader;
123			goto &DynaLoader::bootstrap_inherit;
124			}
125
126			1;
127
128			__END__
129
130			=head1 NAME
131
132			XSLoader - Dynamically load C libraries into Perl code
133
134			=head1 SYNOPSIS
135
136			package YourPackage;
137			use XSLoader;
138
139			XSLoader::load 'YourPackage', $YourPackage::VERSION;
140
141			=head1 DESCRIPTION
142
143			This module defines a standard I<simplified> interface to the dynamic
144			linking mechanisms available on many platforms. Its primary purpose is
145			to implement cheap automatic dynamic loading of Perl modules.
146
147			For more complicated interface see L<DynaLoader>. Many (most)
148			features of DynaLoader are not implemented in XSLoader, like for
149			example the dl_load_flags is not honored by XSLoader.
150
151			=head2 Migration from C<DynaLoader>
152
153			A typical module using L<DynaLoader\|DynaLoader> starts like this:
154
155			package YourPackage;
156			require DynaLoader;
157
158			our @ISA = qw( OnePackage OtherPackage DynaLoader );
159			our $VERSION = '0.01';
160			bootstrap YourPackage $VERSION;
161
162			Change this to
163
164			package YourPackage;
165			use XSLoader;
166
167			our @ISA = qw( OnePackage OtherPackage );
168			our $VERSION = '0.01';
169			XSLoader::load 'YourPackage', $VERSION;
170
171			In other words: replace C<require DynaLoader> by C<use XSLoader>, remove
172			C<DynaLoader> from @ISA, change C<bootstrap> by C<XSLoader::load>. Do not
173			forget to quote the name of your package on the C<XSLoader::load> line,
174			and add comma (C<,>) before the arguments ($VERSION above).
175
176			Of course, if @ISA contained only C<DynaLoader>, there is no need to have the
177			@ISA assignment at all; moreover, if instead of C<our> one uses
178			backward-compatible
179
180			use vars qw($VERSION @ISA);
181
182			one can remove this reference to @ISA together with the @ISA assignment
183
184			If no $VERSION was specified on the C<bootstrap> line, the last line becomes
185
186			XSLoader::load 'YourPackage';
187
188			=head2 Backward compatible boilerplate
189
190			If you want to have your cake and eat it too, you need a more complicated
191			boilerplate.
192
193			package YourPackage;
194			use vars qw($VERSION @ISA);
195
196			@ISA = qw( OnePackage OtherPackage );
197			$VERSION = '0.01';
198			eval {
199			require XSLoader;
200			XSLoader::load('YourPackage', $VERSION);
201			1;
202			} or do {
203			require DynaLoader;
204			push @ISA, 'DynaLoader';
205			bootstrap YourPackage $VERSION;
206			};
207
208			The parentheses about XSLoader::load() arguments are needed since we replaced
209			C<use XSLoader> by C<require>, so the compiler does not know that a function
210			XSLoader::load() is present.
211
212			This boilerplate uses the low-overhead C<XSLoader> if present; if used with
213			an antic Perl which has no C<XSLoader>, it falls back to using C<DynaLoader>.
214
215			=head1 Order of initialization: early load()
216
217			I<Skip this section if the XSUB functions are supposed to be called from other
218			modules only; read it only if you call your XSUBs from the code in your module,
219			or have a C<BOOT:> section in your XS file (see L<perlxs/"The BOOT: Keyword">).
220			What is described here is equally applicable to L<DynaLoader\|DynaLoader>
221			interface.>
222
223			A sufficiently complicated module using XS would have both Perl code (defined
224			in F<YourPackage.pm>) and XS code (defined in F<YourPackage.xs>). If this
225			Perl code makes calls into this XS code, and/or this XS code makes calls to
226			the Perl code, one should be careful with the order of initialization.
227
228			The call to XSLoader::load() (or bootstrap()) has three side effects:
229
230			=over
231
232			=item *
233
234			if $VERSION was specified, a sanity check is done to insure that the versions
235			of the F<.pm> and the (compiled) F<.xs> parts are compatible;
236
237			=item *
238
239			The XSUBs are made accessible from Perl;
240
241			=item *
242
243			If the C<BOOT:> section was present in F<.xs> file, the code there is called.
244
245			=back
246
247			Consequently, if the code in F<.pm> file makes calls to these XSUBs, it is
248			convenient to have XSUBs installed before the Perl code is defined; for
249			example, this makes prototypes for XSUBs visible to this Perl code.
250			Alternatively, if the C<BOOT:> section makes calls to Perl functions (or
251			uses Perl variables) defined in F<.pm> file, they must be defined prior to
252			the call to XSLoader::load() (or bootstrap()).
253
254			The first situation being much more frequent, it makes sense to rewrite the
255			boilerplate as
256
257			package YourPackage;
258			use XSLoader;
259			use vars qw($VERSION @ISA);
260
261			BEGIN {
262			@ISA = qw( OnePackage OtherPackage );
263			$VERSION = '0.01';
264
265			# Put Perl code used in the BOOT: section here
266
267			XSLoader::load 'YourPackage', $VERSION;
268			}
269
270			# Put Perl code making calls into XSUBs here
271
272			=head2 The most hairy case
273
274			If the interdependence of your C<BOOT:> section and Perl code is
275			more complicated than this (e.g., the C<BOOT:> section makes calls to Perl
276			functions which make calls to XSUBs with prototypes), get rid of the C<BOOT:>
277			section altogether. Replace it with a function onBOOT(), and call it like
278			this:
279
280			package YourPackage;
281			use XSLoader;
282			use vars qw($VERSION @ISA);
283
284			BEGIN {
285			@ISA = qw( OnePackage OtherPackage );
286			$VERSION = '0.01';
287			XSLoader::load 'YourPackage', $VERSION;
288			}
289
290			# Put Perl code used in onBOOT() function here; calls to XSUBs are
291			# prototype-checked.
292
293			onBOOT;
294
295			# Put Perl initialization code assuming that XS is initialized here
296
297			=head1 LIMITATIONS
298
299			To reduce the overhead as much as possible, only one possible location
300			is checked to find the extension DLL (this location is where C<make install>
301			would put the DLL). If not found, the search for the DLL is transparently
302			delegated to C<DynaLoader>, which looks for the DLL along the @INC list.
303
304			In particular, this is applicable to the structure of @INC used for testing
305			not-yet-installed extensions. This means that the overhead of running
306			uninstalled extension may be much more than running the same extension after
307			C<make install>.
308
309			=head1 AUTHOR
310
311			Ilya Zakharevich: extraction from DynaLoader.
312
313			=cut
314			EOT
315
316			close OUT or die $!;
317