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)) =~ s/\.PL$//;
18 if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
20 open OUT,">$file" or die "Can't create $file: $!";
22 print "Extracting $file (with variable substitutions)\n";
24 # In this section, perl variables will be expanded during extraction.
25 # You can use $Config{...} to use Configure variables.
27 print OUT <<"!GROK!THIS!";
29 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
30 if \$running_under_some_shell;
33 # In the following, perl variables are not expanded during extraction.
35 print OUT <<'!NO!SUBS!';
39 h2xs - convert .h C header files to Perl extensions
43 B<h2xs> [B<-AOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile [extra_libraries]]
49 I<h2xs> builds a Perl extension from any C header file. The extension will
50 include functions which can be used to retrieve the value of any #define
51 statement which was in the C header.
53 The I<module_name> will be used for the name of the extension. If
54 module_name is not supplied then the name of the header file will be used,
55 with the first character capitalized.
57 If the extension might need extra libraries, they should be included
58 here. The extension Makefile.PL will take care of checking whether
59 the libraries actually exist and how they should be loaded.
60 The extra libraries should be specified in the form -lm -lposix, etc,
61 just as on the cc command line. By default, the Makefile.PL will
62 search through the library path determined by Configure. That path
63 can be augmented by including arguments of the form B<-L/another/library/path>
64 in the extra-libraries argument.
72 Omit all autoload facilities. This is the same as B<-c> but also removes the
73 S<C<require AutoLoader>> statement from the .pm file.
77 Additional flags to specify to C preprocessor when scanning header for
78 function declarations. Should not be used without B<-x>.
82 Allows a pre-existing extension directory to be overwritten.
86 Omit the autogenerated stub POD section.
90 Omit the XS portion. Used to generate templates for a module which is not
95 Omit C<constant()> from the .xs file and corresponding specialised
96 C<AUTOLOAD> from the .pm file.
100 Turn on debugging messages.
104 Allows an extension to be created for a header even if that header is
105 not found in /usr/include.
109 Print the usage, help and version for this h2xs and exit.
111 =item B<-n> I<module_name>
113 Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
115 =item B<-p> I<prefix>
117 Specify a prefix which should be removed from the Perl function names, e.g., S<-p sec_rgy_>
118 This sets up the XS B<PREFIX> keyword and removes the prefix from functions that are
119 autoloaded via the C<constant()> mechansim.
121 =item B<-s> I<sub1,sub2>
123 Create a perl subroutine for the specified macros rather than autoload with the constant() subroutine.
124 These macros are assumed to have a return type of B<char *>, e.g., S<-s sec_rgy_wildcard_name,sec_rgy_wildcard_sid>.
126 =item B<-v> I<version>
128 Specify a version number for this extension. This version number is added
129 to the templates. The default is 0.01.
133 Automatically generate XSUBs basing on function declarations in the
134 header file. The package C<C::Scan> should be installed. If this
135 option is specified, the name of the header file may look like
136 C<NAME1,NAME2>. In this case NAME1 is used instead of the specified string,
137 but XSUBs are emitted only for the declarations included from file NAME2.
139 Note that some types of arguments/return-values for functions may
140 result in XSUB-declarations/typemap-entries which need
141 hand-editing. Such may be objects which cannot be converted from/to a
142 pointer (like C<long long>), pointers to functions, or arrays.
149 # Default behavior, extension is Rusers
152 # Same, but extension is RUSERS
153 h2xs -n RUSERS rpcsvc/rusers
155 # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
158 # Extension is ONC::RPC. Still finds <rpcsvc/rusers.h>
159 h2xs -n ONC::RPC rpcsvc/rusers
161 # Without constant() or AUTOLOAD
162 h2xs -c rpcsvc/rusers
164 # Creates templates for an extension named RPC
167 # Extension is ONC::RPC.
170 # Makefile.PL will look for library -lrpc in
171 # additional directory /opt/net/lib
172 h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
174 # Extension is DCE::rgynbase
175 # prefix "sec_rgy_" is dropped from perl function names
176 h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase
178 # Extension is DCE::rgynbase
179 # prefix "sec_rgy_" is dropped from perl function names
180 # subroutines are created for sec_rgy_wildcard_name and sec_rgy_wildcard_sid
181 h2xs -n DCE::rgynbase -p sec_rgy_ \
182 -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase
184 # Make XS without defines in perl.h, but with function declarations
185 # visible from perl.h. Name of the extension is perl1.
186 # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)=
187 # Extra backslashes below because the string is passed to shell.
188 # Note that a directory with perl header files would
189 # be added automatically to include path.
190 h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h
192 # Same with function declaration in proto.h as visible from perl.h.
193 h2xs -xAn perl2 perl.h,proto.h
197 No environment variables are used.
201 Larry Wall and others
205 L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
209 The usual warnings if it cannot read or write the files involved.
213 my( $H2XS_VERSION ) = ' $Revision: 1.18 $ ' =~ /\$Revision:\s+([^\s]+)/;
214 my $TEMPLATE_VERSION = '0.01';
220 die "h2xs [-AOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]]
221 version: $H2XS_VERSION
222 -A Omit all autoloading facilities (implies -c).
223 -F Additional flags for C preprocessor (used with -x).
224 -O Allow overwriting of a pre-existing extension directory.
225 -P Omit the stub POD section.
226 -X Omit the XS portion.
227 -c Omit the constant() function and specialised AUTOLOAD from the XS file.
228 -d Turn on debugging messages.
229 -f Force creation of the extension even if the C header does not exist.
230 -h Display this help message
231 -n Specify a name to use for the extension (recommended).
232 -p Specify a prefix which should be removed from the Perl function names.
233 -s Create subroutines for specified macros.
234 -v Specify a version number for this extension.
235 -x Autogenerate XSUBs using C::Scan.
237 are any libraries that might be needed for loading the
238 extension, e.g. -lm would try to link in the math library.
243 getopts("AF:OPXcdfhn:p:s:v:x") || usage;
248 $TEMPLATE_VERSION = $opt_v;
250 $opt_c = 1 if $opt_A;
251 %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
254 $extralibs = "@ARGV";
256 usage "Must supply header file or module name\n"
257 unless ($path_h or $opt_n);
262 if( $path_h =~ s#::#/#g && $opt_n ){
263 warn "Nesting of headerfile ignored with -n\n";
265 $path_h .= ".h" unless $path_h =~ /\.h$/;
267 $path_h =~ s/,.*$// if $opt_x;
268 if ($^O eq 'VMS') { # Consider overrides of default location
269 if ($path_h !~ m![:>\[]!) {
270 my($hadsys) = ($path_h =~ s!^sys/!!i);
271 if ($ENV{'DECC$System_Include'}) { $path_h = "DECC\$System_Include:$path_h"; }
272 elsif ($ENV{'DECC$Library_Include'}) { $path_h = "DECC\$Library_Include:$path_h"; }
273 elsif ($ENV{'GNU_CC_Include'}) { $path_h = 'GNU_CC_Include:' .
274 ($hadsys ? '[vms]' : '[000000]') . $path_h; }
275 elsif ($ENV{'VAXC$Include'}) { $path_h = "VAXC\$_Include:$path_h"; }
276 else { $path_h = "Sys\$Library:$path_h"; }
279 elsif ($^O eq 'os2') {
280 $path_h = "/usr/include/$path_h"
281 if $path_h !~ m#^([a-z]:)?[./]#i and -r "/usr/include/$path_h";
284 $path_h = "/usr/include/$path_h"
285 if $path_h !~ m#^[./]# and -r "/usr/include/$path_h";
289 die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
290 # Scan the header file (we should deal with nested header files)
291 # Record the names of simple #define constants into const_names
292 # Function prototypes are not (currently) processed.
293 open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
295 if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) {
296 print "Matched $_ ($1)\n" if $opt_d;
298 next if /^_.*_h_*$/i; # special case, but for what?
299 if (defined $opt_p) {
300 if (!/^$opt_p(\d)/) {
301 ++$prefix{$_} if s/^$opt_p//;
304 warn "can't remove $opt_p prefix from '$_'!\n";
311 @const_names = sort keys %const_names;
316 $module = $opt_n || do {
325 (chdir 'ext', $ext = 'ext/') if -d 'ext';
327 if( $module =~ /::/ ){
329 @modparts = split(/::/,$module);
330 $modfname = $modparts[-1];
331 $modpname = join('/',@modparts);
336 $modfname = $modpname = $module;
341 warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname;
343 die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
348 mkdir("$modpath$_", 0777);
352 mkdir($modpname, 0777);
353 chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
360 if( ! $opt_X ){ # use XS, unless it was disabled
361 open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
363 require C::Scan; # Run-time directive
364 require Config; # Run-time directive
365 warn "Scanning typemaps...\n";
369 my $filename = $path_h;
370 my $addflags = $opt_F || '';
371 if ($fullpath =~ /,/) {
375 warn "Scanning $filename for functions...\n";
376 $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter,
377 'add_cppflags' => $addflags;
378 $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]);
380 $fdecls_parsed = $c->get('parsed_fdecls');
381 $fdecls = $c->get('fdecls');
385 open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
388 warn "Writing $ext$modpname/$modfname.pm\n";
396 if( $opt_X || $opt_c || $opt_A ){
397 # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD
399 use vars qw($VERSION @ISA @EXPORT);
403 # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
407 use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
416 print PM <<"END" if ! $opt_X; # use DynaLoader, unless XS was disabled
420 # require autoloader if XS is disabled.
421 # if XS is enabled, require autoloader unless autoloading is disabled.
422 if( $opt_X || (! $opt_A) ){
428 if( $opt_X || ($opt_c && ! $opt_A) ){
429 # we won't have our own AUTOLOAD(), so we'll inherit it.
430 if( ! $opt_X ) { # use DynaLoader, unless XS was disabled
433 \@ISA = qw(Exporter AutoLoader DynaLoader);
439 \@ISA = qw(Exporter AutoLoader);
444 # 1) we have our own AUTOLOAD(), so don't need to inherit it.
446 # 2) we don't want autoloading mentioned.
447 if( ! $opt_X ){ # use DynaLoader, unless XS was disabled
450 \@ISA = qw(Exporter DynaLoader);
456 \@ISA = qw(Exporter);
462 # Items to export into callers namespace by default. Note: do not export
463 # names by default without a very good reason. Use EXPORT_OK instead.
464 # Do not simply export all your public functions/methods/constants.
468 \$VERSION = '$TEMPLATE_VERSION';
472 print PM <<"END" unless $opt_c or $opt_X;
474 # This AUTOLOAD is used to 'autoload' constants from the constant()
475 # XS function. If a constant is not found then control is passed
476 # to the AUTOLOAD in AutoLoader.
479 (\$constname = \$AUTOLOAD) =~ s/.*:://;
480 my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
482 if (\$! =~ /Invalid/) {
483 \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
484 goto &AutoLoader::AUTOLOAD;
487 croak "Your vendor has not defined $module macro \$constname";
490 eval "sub \$AUTOLOAD { \$val }";
496 if( ! $opt_X ){ # print bootstrap, unless XS is disabled
498 bootstrap $module \$VERSION;
502 if( $opt_P ){ # if POD is disabled
511 # Preloaded methods go here.
513 # Autoload methods go after $after, and are processed by the autosplit program.
519 $author = "A. U. Thor";
520 $email = 'a.u.thor@a.galaxy.far.far.away';
524 if (@const_names and not $opt_P) {
526 \n=head1 Exported constants
528 @{[join "\n ", @const_names]}
532 if (defined $fdecls and @$fdecls and not $opt_P) {
534 \n=head1 Exported functions
536 @{[join "\n ", @$fdecls]}
541 $pod = <<"END" unless $opt_P;
542 ## Below is the stub of documentation for your module. You better edit it!
546 #$module - Perl extension for blah blah blah
555 #Stub documentation for $module was created by h2xs. It looks like the
556 #author of the extension was negligent enough to leave the stub
560 #$const_doc$fdecl_doc
572 $pod =~ s/^\#//gm unless $opt_P;
573 print PM $pod unless $opt_P;
578 if( ! $opt_X ){ # print XS, unless it is disabled
579 warn "Writing $ext$modpname/$modfname.xs\n";
595 $h =~ s#^/usr/include/##;
596 if ($^O eq 'VMS') { $h =~ s#.*vms\]#sys/# or $h =~ s#.*[:>\]]##; }
609 croak("$module::%s not implemented on this architecture", s);
622 my(@AZ, @az, @under);
624 foreach(@const_names){
625 @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
626 @az = 'a' .. 'z' if !@az && /^[a-z]/;
627 @under = '_' if !@under && /^_/;
630 foreach $letter (@AZ, @az, @under) {
632 last if $letter eq 'a' && !@const_names;
634 print XS " case '$letter':\n";
636 while (substr($const_names[0],0,1) eq $letter) {
637 $name = shift(@const_names);
638 $macro = $prefix{$name} ? "$opt_p$name" : $name;
639 next if $const_xsub{$macro};
641 if (strEQ(name, "$name"))
666 $prefix = "PREFIX = $opt_p" if defined $opt_p;
667 # Now switch from C to XS by issuing the first MODULE declaration:
670 MODULE = $module PACKAGE = $module $prefix
674 foreach (sort keys %const_xsub) {
683 croak("Your vendor has not defined the $module macro $_");
692 # If a constant() function was written then output a corresponding
694 print XS <<"END" unless $opt_c;
709 my ($type, $name, $args) = @$decl;
710 return if $seen_decl{$name}++; # Need to do the same for docs as well?
712 my @argnames = map {$_->[1]} @$args;
713 my @argtypes = map { normalize_type( $_->[0] ) } @$args;
714 my @argarrays = map { $_->[4] || '' } @$args;
715 my $numargs = @$args;
716 if ($numargs and $argtypes[-1] eq '...') {
718 $argnames[-1] = '...';
721 $type = normalize_type($type);
729 for $arg (0 .. $numargs - 1) {
731 $argtypes[$arg] $argnames[$arg]$argarrays[$arg]
736 # Should be called before any actual call to normalize_type().
738 # We do not want to read ./typemap by obvios reasons.
739 my @tm = qw(../../../typemap ../../typemap ../typemap);
740 my $stdtypemap = "$Config::Config{privlib}/ExtUtils/typemap";
741 unshift @tm, $stdtypemap;
742 my $proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
745 foreach $typemap (@tm) {
746 next unless -e $typemap ;
747 # skip directories, binary files etc.
748 warn " Scanning $typemap\n";
749 warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
751 open(TYPEMAP, $typemap)
752 or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
753 my $mode = 'Typemap';
756 if (/^INPUT\s*$/) { $mode = 'Input'; next; }
757 elsif (/^OUTPUT\s*$/) { $mode = 'Output'; next; }
758 elsif (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; }
759 elsif ($mode eq 'Typemap') {
760 next if /^\s*($|\#)/ ;
761 if ( ($type, $image) =
762 /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/o
763 # This may reference undefined functions:
764 and not ($image eq 'T_PACKED' and $typemap eq $stdtypemap)) {
765 normalize_type($type);
769 close(TYPEMAP) or die "Cannot close $typemap: $!";
771 %std_types = %types_seen;
777 my $ignore_mods = '(?:\b(?:__const__|static|inline|__inline__)\b\s*)*';
779 $type =~ s/$ignore_mods//go;
780 $type =~ s/([\]\[()])/ \1 /g;
784 $type =~ s/\b\*/ */g;
785 $type =~ s/\*\b/* /g;
786 $type =~ s/\*\s+(?=\*)/*/g;
788 unless $type eq '...' or $type eq 'void' or $std_types{$type};
793 for $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) }
800 warn "Writing $ext$modpname/typemap\n";
801 open TM, ">typemap" or die "Cannot open typemap file for write: $!";
803 for $type (keys %types_seen) {
804 print TM $type, "\t" x (6 - int((length $type)/8)), "T_PTROBJ\n"
807 close TM or die "Cannot close typemap file for write: $!";
812 warn "Writing $ext$modpname/Makefile.PL\n";
813 open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
816 use ExtUtils::MakeMaker;
817 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
818 # the contents of the Makefile that is written.
820 print PL "WriteMakefile(\n";
821 print PL " 'NAME' => '$module',\n";
822 print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n";
823 if( ! $opt_X ){ # print C stuff, unless XS is disabled
824 print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
825 print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
826 print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
829 close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
831 warn "Writing $ext$modpname/test.pl\n";
832 open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
834 # Before `make install' is performed this script should be runnable with
835 # `make test'. After `make install' it should work as `perl test.pl'
837 ######################### We start with some black magic to print on failure.
839 # Change 1..1 below to 1..last_test_to_print .
840 # (It may become useful if the test is moved to ./t subdirectory.)
842 BEGIN { $| = 1; print "1..1\n"; }
843 END {print "not ok 1\n" unless $loaded;}
852 ######################### End of black magic.
854 # Insert your test code below (better if it prints "ok 13"
855 # (correspondingly "not ok 13") depending on the success of chunk 13
859 close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
861 warn "Writing $ext$modpname/Changes\n";
862 open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n";
863 print EX "Revision history for Perl extension $module.\n\n";
864 print EX "$TEMPLATE_VERSION ",scalar localtime,"\n";
865 print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n";
866 close(EX) || die "Can't close $ext$modpname/Changes: $!\n";
868 warn "Writing $ext$modpname/MANIFEST\n";
869 open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
872 eval {opendir(D,'.');};
873 unless ($@) { @files = readdir(D); closedir(D); }
875 if (!@files) { @files = map {chomp && $_} `ls`; }
878 # Clip trailing '.' for portability -- non-VMS OSs don't expect it
880 # Fix up for case-sensitive file systems
881 s/$modfname/$modfname/i && next;
882 $_ = "\U$_" if $_ eq 'manifest' or $_ eq 'changes';
883 $_ = 'Makefile.PL' if $_ eq 'makefile.pl';
886 print MANI join("\n",@files);
890 close OUT or die "Can't close $file: $!";
891 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
892 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';