4 use File::Basename qw(&basename &dirname);
6 # List explicitly here the variables you want Configure to
7 # generate. Metaconfig only looks for shell variables, so you
8 # have to mention them as if they were shell variables, not
9 # %Config entries. Thus you write
11 # to ensure Configure will look for $Config{startperl}.
13 # This forces PL files to create target in same directory as PL file.
14 # This is so that make depend always knows where to find PL derivatives.
16 $file = basename($0, '.PL');
17 $file .= '.com' if $^O eq 'VMS';
19 open OUT,">$file" or die "Can't create $file: $!";
21 print "Extracting $file (with variable substitutions)\n";
23 # In this section, perl variables will be expanded during extraction.
24 # You can use $Config{...} to use Configure variables.
26 print OUT <<"!GROK!THIS!";
28 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
29 if \$running_under_some_shell;
32 # In the following, perl variables are not expanded during extraction.
34 print OUT <<'!NO!SUBS!';
38 h2xs - convert .h C header files to Perl extensions
42 B<h2xs> [B<-AOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile ... [extra_libraries]]
48 I<h2xs> builds a Perl extension from C header files. The extension
49 will include functions which can be used to retrieve the value of any
50 #define statement which was in the C header files.
52 The I<module_name> will be used for the name of the extension. If
53 module_name is not supplied then the name of the first header file
54 will be used, with the first character capitalized.
56 If the extension might need extra libraries, they should be included
57 here. The extension Makefile.PL will take care of checking whether
58 the libraries actually exist and how they should be loaded.
59 The extra libraries should be specified in the form -lm -lposix, etc,
60 just as on the cc command line. By default, the Makefile.PL will
61 search through the library path determined by Configure. That path
62 can be augmented by including arguments of the form B<-L/another/library/path>
63 in the extra-libraries argument.
71 Omit all autoload facilities. This is the same as B<-c> but also removes the
72 S<C<require AutoLoader>> statement from the .pm file.
76 Additional flags to specify to C preprocessor when scanning header for
77 function declarations. Should not be used without B<-x>.
81 Allows a pre-existing extension directory to be overwritten.
85 Omit the autogenerated stub POD section.
89 Omit the XS portion. Used to generate templates for a module which is not
94 Omit C<constant()> from the .xs file and corresponding specialised
95 C<AUTOLOAD> from the .pm file.
99 Turn on debugging messages.
103 Allows an extension to be created for a header even if that header is
104 not found in /usr/include.
108 Print the usage, help and version for this h2xs and exit.
110 =item B<-n> I<module_name>
112 Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
114 =item B<-p> I<prefix>
116 Specify a prefix which should be removed from the Perl function names, e.g., S<-p sec_rgy_>
117 This sets up the XS B<PREFIX> keyword and removes the prefix from functions that are
118 autoloaded via the C<constant()> mechansim.
120 =item B<-s> I<sub1,sub2>
122 Create a perl subroutine for the specified macros rather than autoload with the constant() subroutine.
123 These macros are assumed to have a return type of B<char *>, e.g., S<-s sec_rgy_wildcard_name,sec_rgy_wildcard_sid>.
125 =item B<-v> I<version>
127 Specify a version number for this extension. This version number is added
128 to the templates. The default is 0.01.
132 Automatically generate XSUBs basing on function declarations in the
133 header file. The package C<C::Scan> should be installed. If this
134 option is specified, the name of the header file may look like
135 C<NAME1,NAME2>. In this case NAME1 is used instead of the specified string,
136 but XSUBs are emitted only for the declarations included from file NAME2.
138 Note that some types of arguments/return-values for functions may
139 result in XSUB-declarations/typemap-entries which need
140 hand-editing. Such may be objects which cannot be converted from/to a
141 pointer (like C<long long>), pointers to functions, or arrays.
148 # Default behavior, extension is Rusers
151 # Same, but extension is RUSERS
152 h2xs -n RUSERS rpcsvc/rusers
154 # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
157 # Extension is ONC::RPC. Still finds <rpcsvc/rusers.h>
158 h2xs -n ONC::RPC rpcsvc/rusers
160 # Without constant() or AUTOLOAD
161 h2xs -c rpcsvc/rusers
163 # Creates templates for an extension named RPC
166 # Extension is ONC::RPC.
169 # Makefile.PL will look for library -lrpc in
170 # additional directory /opt/net/lib
171 h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
173 # Extension is DCE::rgynbase
174 # prefix "sec_rgy_" is dropped from perl function names
175 h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase
177 # Extension is DCE::rgynbase
178 # prefix "sec_rgy_" is dropped from perl function names
179 # subroutines are created for sec_rgy_wildcard_name and sec_rgy_wildcard_sid
180 h2xs -n DCE::rgynbase -p sec_rgy_ \
181 -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase
183 # Make XS without defines in perl.h, but with function declarations
184 # visible from perl.h. Name of the extension is perl1.
185 # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)=
186 # Extra backslashes below because the string is passed to shell.
187 # Note that a directory with perl header files would
188 # be added automatically to include path.
189 h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h
191 # Same with function declaration in proto.h as visible from perl.h.
192 h2xs -xAn perl2 perl.h,proto.h
196 No environment variables are used.
200 Larry Wall and others
204 L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
208 The usual warnings if it cannot read or write the files involved.
212 my( $H2XS_VERSION ) = ' $Revision: 1.18 $ ' =~ /\$Revision:\s+([^\s]+)/;
213 my $TEMPLATE_VERSION = '0.01';
219 die "h2xs [-AOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]]
220 version: $H2XS_VERSION
221 -A Omit all autoloading facilities (implies -c).
222 -F Additional flags for C preprocessor (used with -x).
223 -O Allow overwriting of a pre-existing extension directory.
224 -P Omit the stub POD section.
225 -X Omit the XS portion.
226 -c Omit the constant() function and specialised AUTOLOAD from the XS file.
227 -d Turn on debugging messages.
228 -f Force creation of the extension even if the C header does not exist.
229 -h Display this help message
230 -n Specify a name to use for the extension (recommended).
231 -p Specify a prefix which should be removed from the Perl function names.
232 -s Create subroutines for specified macros.
233 -v Specify a version number for this extension.
234 -x Autogenerate XSUBs using C::Scan.
236 are any libraries that might be needed for loading the
237 extension, e.g. -lm would try to link in the math library.
242 getopts("AF:OPXcdfhn:p:s:v:x") || usage;
247 $TEMPLATE_VERSION = $opt_v;
249 $opt_c = 1 if $opt_A;
250 %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
252 while (my $arg = shift) {
253 if ($arg =~ /^-l/i) {
254 $extralibs = "$arg @ARGV";
260 usage "Must supply header file or module name\n"
261 unless (@path_h or $opt_n);
265 foreach my $path_h (@path_h) {
267 if( $path_h =~ s#::#/#g && $opt_n ){
268 warn "Nesting of headerfile ignored with -n\n";
270 $path_h .= ".h" unless $path_h =~ /\.h$/;
272 $path_h =~ s/,.*$// if $opt_x;
273 if ($^O eq 'VMS') { # Consider overrides of default location
274 if ($path_h !~ m![:>\[]!) {
275 my($hadsys) = ($path_h =~ s!^sys/!!i);
276 if ($ENV{'DECC$System_Include'}) { $path_h = "DECC\$System_Include:$path_h"; }
277 elsif ($ENV{'DECC$Library_Include'}) { $path_h = "DECC\$Library_Include:$path_h"; }
278 elsif ($ENV{'GNU_CC_Include'}) { $path_h = 'GNU_CC_Include:' .
279 ($hadsys ? '[vms]' : '[000000]') . $path_h; }
280 elsif ($ENV{'VAXC$Include'}) { $path_h = "VAXC\$_Include:$path_h"; }
281 else { $path_h = "Sys\$Library:$path_h"; }
284 elsif ($^O eq 'os2') {
285 $path_h = "/usr/include/$path_h"
286 if $path_h !~ m#^([a-z]:)?[./]#i and -r "/usr/include/$path_h";
289 $path_h = "/usr/include/$path_h"
290 if $path_h !~ m#^[./]# and -r "/usr/include/$path_h";
294 die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
295 # Scan the header file (we should deal with nested header files)
296 # Record the names of simple #define constants into const_names
297 # Function prototypes are processed below.
298 open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
300 if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) {
301 print "Matched $_ ($1)\n" if $opt_d;
303 next if /^_.*_h_*$/i; # special case, but for what?
304 if (defined $opt_p) {
305 if (!/^$opt_p(\d)/) {
306 ++$prefix{$_} if s/^$opt_p//;
309 warn "can't remove $opt_p prefix from '$_'!\n";
318 @const_names = sort keys %const_names;
322 $module = $opt_n || do {
331 (chdir 'ext', $ext = 'ext/') if -d 'ext';
333 if( $module =~ /::/ ){
335 @modparts = split(/::/,$module);
336 $modfname = $modparts[-1];
337 $modpname = join('/',@modparts);
342 $modfname = $modpname = $module;
347 warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname;
349 die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
354 mkdir("$modpath$_", 0777);
358 mkdir($modpname, 0777);
359 chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
366 if( ! $opt_X ){ # use XS, unless it was disabled
367 open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
369 require C::Scan; # Run-time directive
370 require Config; # Run-time directive
371 warn "Scanning typemaps...\n";
376 foreach my $filename (@path_h) {
377 my $addflags = $opt_F || '';
378 if ($fullpath =~ /,/) {
382 warn "Scanning $filename for functions...\n";
383 $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter,
384 'add_cppflags' => $addflags;
385 $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]);
387 $fdecls_parsed = $c->get('parsed_fdecls');
388 push(@fdecls, @{$c->get('fdecls')});
390 $fdecls = [ @fdecls ];
394 open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
397 warn "Writing $ext$modpname/$modfname.pm\n";
405 if( $opt_X || $opt_c || $opt_A ){
406 # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD
408 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
412 # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
416 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
425 print PM <<"END" if ! $opt_X; # use DynaLoader, unless XS was disabled
429 # require autoloader if XS is disabled.
430 # if XS is enabled, require autoloader unless autoloading is disabled.
431 if( ($opt_X && (! $opt_A)) || (!$opt_X) ) {
437 if( $opt_X || ($opt_c && ! $opt_A) ){
438 # we won't have our own AUTOLOAD(), so we'll inherit it.
439 if( ! $opt_X ) { # use DynaLoader, unless XS was disabled
442 \@ISA = qw(Exporter AutoLoader DynaLoader);
448 \@ISA = qw(Exporter AutoLoader);
453 # 1) we have our own AUTOLOAD(), so don't need to inherit it.
455 # 2) we don't want autoloading mentioned.
456 if( ! $opt_X ){ # use DynaLoader, unless XS was disabled
459 \@ISA = qw(Exporter DynaLoader);
465 \@ISA = qw(Exporter);
471 # Items to export into callers namespace by default. Note: do not export
472 # names by default without a very good reason. Use EXPORT_OK instead.
473 # Do not simply export all your public functions/methods/constants.
477 \$VERSION = '$TEMPLATE_VERSION';
481 print PM <<"END" unless $opt_c or $opt_X;
483 # This AUTOLOAD is used to 'autoload' constants from the constant()
484 # XS function. If a constant is not found then control is passed
485 # to the AUTOLOAD in AutoLoader.
488 (\$constname = \$AUTOLOAD) =~ s/.*:://;
489 my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
491 if (\$! =~ /Invalid/) {
492 \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
493 goto &AutoLoader::AUTOLOAD;
496 croak "Your vendor has not defined $module macro \$constname";
499 eval "sub \$AUTOLOAD { \$val }";
505 if( ! $opt_X ){ # print bootstrap, unless XS is disabled
507 bootstrap $module \$VERSION;
511 if( $opt_P ){ # if POD is disabled
520 # Preloaded methods go here.
522 # Autoload methods go after $after, and are processed by the autosplit program.
528 $author = "A. U. Thor";
529 $email = 'a.u.thor@a.galaxy.far.far.away';
533 if (@const_names and not $opt_P) {
535 \n=head1 Exported constants
537 @{[join "\n ", @const_names]}
541 if (defined $fdecls and @$fdecls and not $opt_P) {
543 \n=head1 Exported functions
545 @{[join "\n ", @$fdecls]}
550 $pod = <<"END" unless $opt_P;
551 ## Below is the stub of documentation for your module. You better edit it!
555 #$module - Perl extension for blah blah blah
564 #Stub documentation for $module was created by h2xs. It looks like the
565 #author of the extension was negligent enough to leave the stub
569 #$const_doc$fdecl_doc
581 $pod =~ s/^\#//gm unless $opt_P;
582 print PM $pod unless $opt_P;
587 if( ! $opt_X ){ # print XS, unless it is disabled
588 warn "Writing $ext$modpname/$modfname.xs\n";
603 foreach my $path_h (@path_h) {
605 $h =~ s#^/usr/include/##;
606 if ($^O eq 'VMS') { $h =~ s#.*vms\]#sys/# or $h =~ s#.*[:>\]]##; }
607 print XS qq{#include <$h>\n};
618 croak("$module::%s not implemented on this architecture", s);
631 my(@AZ, @az, @under);
633 foreach(@const_names){
634 @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
635 @az = 'a' .. 'z' if !@az && /^[a-z]/;
636 @under = '_' if !@under && /^_/;
639 foreach $letter (@AZ, @az, @under) {
641 last if $letter eq 'a' && !@const_names;
643 print XS " case '$letter':\n";
645 while (substr($const_names[0],0,1) eq $letter) {
646 $name = shift(@const_names);
647 $macro = $prefix{$name} ? "$opt_p$name" : $name;
648 next if $const_xsub{$macro};
650 if (strEQ(name, "$name"))
675 $prefix = "PREFIX = $opt_p" if defined $opt_p;
676 # Now switch from C to XS by issuing the first MODULE declaration:
679 MODULE = $module PACKAGE = $module $prefix
683 foreach (sort keys %const_xsub) {
692 croak("Your vendor has not defined the $module macro $_");
701 # If a constant() function was written then output a corresponding
703 print XS <<"END" unless $opt_c;
718 my ($type, $name, $args) = @$decl;
719 return if $seen_decl{$name}++; # Need to do the same for docs as well?
721 my @argnames = map {$_->[1]} @$args;
722 my @argtypes = map { normalize_type( $_->[0] ) } @$args;
723 my @argarrays = map { $_->[4] || '' } @$args;
724 my $numargs = @$args;
725 if ($numargs and $argtypes[-1] eq '...') {
727 $argnames[-1] = '...';
730 $type = normalize_type($type);
738 for $arg (0 .. $numargs - 1) {
740 $argtypes[$arg] $argnames[$arg]$argarrays[$arg]
745 # Should be called before any actual call to normalize_type().
747 # We do not want to read ./typemap by obvios reasons.
748 my @tm = qw(../../../typemap ../../typemap ../typemap);
749 my $stdtypemap = "$Config::Config{privlib}/ExtUtils/typemap";
750 unshift @tm, $stdtypemap;
751 my $proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
754 foreach $typemap (@tm) {
755 next unless -e $typemap ;
756 # skip directories, binary files etc.
757 warn " Scanning $typemap\n";
758 warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
760 open(TYPEMAP, $typemap)
761 or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
762 my $mode = 'Typemap';
765 if (/^INPUT\s*$/) { $mode = 'Input'; next; }
766 elsif (/^OUTPUT\s*$/) { $mode = 'Output'; next; }
767 elsif (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; }
768 elsif ($mode eq 'Typemap') {
769 next if /^\s*($|\#)/ ;
770 if ( ($type, $image) =
771 /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/o
772 # This may reference undefined functions:
773 and not ($image eq 'T_PACKED' and $typemap eq $stdtypemap)) {
774 normalize_type($type);
778 close(TYPEMAP) or die "Cannot close $typemap: $!";
780 %std_types = %types_seen;
786 my $ignore_mods = '(?:\b(?:__const__|static|inline|__inline__)\b\s*)*';
788 $type =~ s/$ignore_mods//go;
789 $type =~ s/([\]\[()])/ \1 /g;
793 $type =~ s/\b\*/ */g;
794 $type =~ s/\*\b/* /g;
795 $type =~ s/\*\s+(?=\*)/*/g;
797 unless $type eq '...' or $type eq 'void' or $std_types{$type};
802 for $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) }
809 warn "Writing $ext$modpname/typemap\n";
810 open TM, ">typemap" or die "Cannot open typemap file for write: $!";
812 for $type (keys %types_seen) {
813 print TM $type, "\t" x (6 - int((length $type)/8)), "T_PTROBJ\n"
816 close TM or die "Cannot close typemap file for write: $!";
821 warn "Writing $ext$modpname/Makefile.PL\n";
822 open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
825 use ExtUtils::MakeMaker;
826 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
827 # the contents of the Makefile that is written.
829 print PL "WriteMakefile(\n";
830 print PL " 'NAME' => '$module',\n";
831 print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n";
832 if( ! $opt_X ){ # print C stuff, unless XS is disabled
833 print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
834 print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
835 print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
838 close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
840 warn "Writing $ext$modpname/test.pl\n";
841 open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
843 # Before `make install' is performed this script should be runnable with
844 # `make test'. After `make install' it should work as `perl test.pl'
846 ######################### We start with some black magic to print on failure.
848 # Change 1..1 below to 1..last_test_to_print .
849 # (It may become useful if the test is moved to ./t subdirectory.)
851 BEGIN { $| = 1; print "1..1\n"; }
852 END {print "not ok 1\n" unless $loaded;}
861 ######################### End of black magic.
863 # Insert your test code below (better if it prints "ok 13"
864 # (correspondingly "not ok 13") depending on the success of chunk 13
868 close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
870 warn "Writing $ext$modpname/Changes\n";
871 open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n";
872 print EX "Revision history for Perl extension $module.\n\n";
873 print EX "$TEMPLATE_VERSION ",scalar localtime,"\n";
874 print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n";
875 close(EX) || die "Can't close $ext$modpname/Changes: $!\n";
877 warn "Writing $ext$modpname/MANIFEST\n";
878 open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
881 eval {opendir(D,'.');};
882 unless ($@) { @files = readdir(D); closedir(D); }
884 if (!@files) { @files = map {chomp && $_} `ls`; }
887 # Clip trailing '.' for portability -- non-VMS OSs don't expect it
889 # Fix up for case-sensitive file systems
890 s/$modfname/$modfname/i && next;
891 $_ = "\U$_" if $_ eq 'manifest' or $_ eq 'changes';
892 $_ = 'Makefile.PL' if $_ eq 'makefile.pl';
895 print MANI join("\n",@files), "\n";
899 close OUT or die "Can't close $file: $!";
900 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
901 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';