4 use File::Basename qw(&basename &dirname);
7 # List explicitly here the variables you want Configure to
8 # generate. Metaconfig only looks for shell variables, so you
9 # have to mention them as if they were shell variables, not
10 # %Config entries. Thus you write
12 # to ensure Configure will look for $Config{startperl}.
14 # This forces PL files to create target in same directory as PL file.
15 # This is so that make depend always knows where to find PL derivatives.
18 $file = basename($0, '.PL');
19 $file .= '.com' if $^O eq 'VMS';
21 open OUT,">$file" or die "Can't create $file: $!";
23 print "Extracting $file (with variable substitutions)\n";
25 # In this section, perl variables will be expanded during extraction.
26 # You can use $Config{...} to use Configure variables.
28 print OUT <<"!GROK!THIS!";
30 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
31 if \$running_under_some_shell;
34 # In the following, perl variables are not expanded during extraction.
36 print OUT <<'!NO!SUBS!';
40 h2xs - convert .h C header files to Perl extensions
44 B<h2xs> [B<-AOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile ... [extra_libraries]]
50 I<h2xs> builds a Perl extension from C header files. The extension
51 will include functions which can be used to retrieve the value of any
52 #define statement which was in the C header files.
54 The I<module_name> will be used for the name of the extension. If
55 module_name is not supplied then the name of the first header file
56 will be used, with the first character capitalized.
58 If the extension might need extra libraries, they should be included
59 here. The extension Makefile.PL will take care of checking whether
60 the libraries actually exist and how they should be loaded.
61 The extra libraries should be specified in the form -lm -lposix, etc,
62 just as on the cc command line. By default, the Makefile.PL will
63 search through the library path determined by Configure. That path
64 can be augmented by including arguments of the form B<-L/another/library/path>
65 in the extra-libraries argument.
73 Omit all autoload facilities. This is the same as B<-c> but also removes the
74 S<C<require AutoLoader>> statement from the .pm file.
78 Additional flags to specify to C preprocessor when scanning header for
79 function declarations. Should not be used without B<-x>.
83 Allows a pre-existing extension directory to be overwritten.
87 Omit the autogenerated stub POD section.
91 Omit the XS portion. Used to generate templates for a module which is not
96 Omit C<constant()> from the .xs file and corresponding specialised
97 C<AUTOLOAD> from the .pm file.
101 Turn on debugging messages.
105 Allows an extension to be created for a header even if that header is
106 not found in /usr/include.
110 Print the usage, help and version for this h2xs and exit.
112 =item B<-n> I<module_name>
114 Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
116 =item B<-p> I<prefix>
118 Specify a prefix which should be removed from the Perl function names, e.g., S<-p sec_rgy_>
119 This sets up the XS B<PREFIX> keyword and removes the prefix from functions that are
120 autoloaded via the C<constant()> mechansim.
122 =item B<-s> I<sub1,sub2>
124 Create a perl subroutine for the specified macros rather than autoload with the constant() subroutine.
125 These macros are assumed to have a return type of B<char *>, e.g., S<-s sec_rgy_wildcard_name,sec_rgy_wildcard_sid>.
127 =item B<-v> I<version>
129 Specify a version number for this extension. This version number is added
130 to the templates. The default is 0.01.
134 Automatically generate XSUBs basing on function declarations in the
135 header file. The package C<C::Scan> should be installed. If this
136 option is specified, the name of the header file may look like
137 C<NAME1,NAME2>. In this case NAME1 is used instead of the specified string,
138 but XSUBs are emitted only for the declarations included from file NAME2.
140 Note that some types of arguments/return-values for functions may
141 result in XSUB-declarations/typemap-entries which need
142 hand-editing. Such may be objects which cannot be converted from/to a
143 pointer (like C<long long>), pointers to functions, or arrays.
150 # Default behavior, extension is Rusers
153 # Same, but extension is RUSERS
154 h2xs -n RUSERS rpcsvc/rusers
156 # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
159 # Extension is ONC::RPC. Still finds <rpcsvc/rusers.h>
160 h2xs -n ONC::RPC rpcsvc/rusers
162 # Without constant() or AUTOLOAD
163 h2xs -c rpcsvc/rusers
165 # Creates templates for an extension named RPC
168 # Extension is ONC::RPC.
171 # Makefile.PL will look for library -lrpc in
172 # additional directory /opt/net/lib
173 h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
175 # Extension is DCE::rgynbase
176 # prefix "sec_rgy_" is dropped from perl function names
177 h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase
179 # Extension is DCE::rgynbase
180 # prefix "sec_rgy_" is dropped from perl function names
181 # subroutines are created for sec_rgy_wildcard_name and sec_rgy_wildcard_sid
182 h2xs -n DCE::rgynbase -p sec_rgy_ \
183 -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase
185 # Make XS without defines in perl.h, but with function declarations
186 # visible from perl.h. Name of the extension is perl1.
187 # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)=
188 # Extra backslashes below because the string is passed to shell.
189 # Note that a directory with perl header files would
190 # be added automatically to include path.
191 h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h
193 # Same with function declaration in proto.h as visible from perl.h.
194 h2xs -xAn perl2 perl.h,proto.h
198 No environment variables are used.
202 Larry Wall and others
206 L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
210 The usual warnings if it cannot read or write the files involved.
214 my( $H2XS_VERSION ) = ' $Revision: 1.19 $ ' =~ /\$Revision:\s+([^\s]+)/;
215 my $TEMPLATE_VERSION = '0.01';
221 die "h2xs [-AOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]]
222 version: $H2XS_VERSION
223 -A Omit all autoloading facilities (implies -c).
224 -F Additional flags for C preprocessor (used with -x).
225 -O Allow overwriting of a pre-existing extension directory.
226 -P Omit the stub POD section.
227 -X Omit the XS portion.
228 -c Omit the constant() function and specialised AUTOLOAD from the XS file.
229 -d Turn on debugging messages.
230 -f Force creation of the extension even if the C header does not exist.
231 -h Display this help message
232 -n Specify a name to use for the extension (recommended).
233 -p Specify a prefix which should be removed from the Perl function names.
234 -s Create subroutines for specified macros.
235 -v Specify a version number for this extension.
236 -x Autogenerate XSUBs using C::Scan.
238 are any libraries that might be needed for loading the
239 extension, e.g. -lm would try to link in the math library.
244 getopts("AF:OPXcdfhn:p:s:v:x") || usage;
249 $TEMPLATE_VERSION = $opt_v;
251 $opt_c = 1 if $opt_A;
252 %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
254 while (my $arg = shift) {
255 if ($arg =~ /^-l/i) {
256 $extralibs = "$arg @ARGV";
262 usage "Must supply header file or module name\n"
263 unless (@path_h or $opt_n);
267 foreach my $path_h (@path_h) {
269 if( $path_h =~ s#::#/#g && $opt_n ){
270 warn "Nesting of headerfile ignored with -n\n";
272 $path_h .= ".h" unless $path_h =~ /\.h$/;
274 $path_h =~ s/,.*$// if $opt_x;
275 if ($^O eq 'VMS') { # Consider overrides of default location
276 if ($path_h !~ m![:>\[]!) {
277 my($hadsys) = ($path_h =~ s!^sys/!!i);
278 if ($ENV{'DECC$System_Include'}) { $path_h = "DECC\$System_Include:$path_h"; }
279 elsif ($ENV{'DECC$Library_Include'}) { $path_h = "DECC\$Library_Include:$path_h"; }
280 elsif ($ENV{'GNU_CC_Include'}) { $path_h = 'GNU_CC_Include:' .
281 ($hadsys ? '[vms]' : '[000000]') . $path_h; }
282 elsif ($ENV{'VAXC$Include'}) { $path_h = "VAXC\$_Include:$path_h"; }
283 else { $path_h = "Sys\$Library:$path_h"; }
286 elsif ($^O eq 'os2') {
287 $path_h = "/usr/include/$path_h"
288 if $path_h !~ m#^([a-z]:)?[./]#i and -r "/usr/include/$path_h";
291 $path_h = "/usr/include/$path_h"
292 if $path_h !~ m#^[./]# and -r "/usr/include/$path_h";
296 die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
297 # Scan the header file (we should deal with nested header files)
298 # Record the names of simple #define constants into const_names
299 # Function prototypes are processed below.
300 open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
302 if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) {
303 print "Matched $_ ($1)\n" if $opt_d;
305 next if /^_.*_h_*$/i; # special case, but for what?
306 if (defined $opt_p) {
307 if (!/^$opt_p(\d)/) {
308 ++$prefix{$_} if s/^$opt_p//;
311 warn "can't remove $opt_p prefix from '$_'!\n";
320 @const_names = sort keys %const_names;
324 $module = $opt_n || do {
333 (chdir 'ext', $ext = 'ext/') if -d 'ext';
335 if( $module =~ /::/ ){
337 @modparts = split(/::/,$module);
338 $modfname = $modparts[-1];
339 $modpname = join('/',@modparts);
344 $modfname = $modpname = $module;
349 warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname;
351 die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
356 mkdir("$modpath$_", 0777);
360 mkdir($modpname, 0777);
361 chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
366 my $fdecls_parsed = [];
368 if( ! $opt_X ){ # use XS, unless it was disabled
369 open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
371 require C::Scan; # Run-time directive
372 require Config; # Run-time directive
373 warn "Scanning typemaps...\n";
377 foreach my $filename (@path_h) {
378 my $addflags = $opt_F || '';
379 if ($fullpath =~ /,/) {
383 warn "Scanning $filename for functions...\n";
384 $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter,
385 'add_cppflags' => $addflags;
386 $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]);
388 push @$fdecls_parsed, @{ $c->get('parsed_fdecls') };
389 push(@$fdecls, @{$c->get('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 croak "&$module::constant not defined" if \$constname eq 'constant';
490 my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
492 if (\$! =~ /Invalid/) {
493 \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
494 goto &AutoLoader::AUTOLOAD;
497 croak "Your vendor has not defined $module macro \$constname";
500 *\$AUTOLOAD = sub () { \$val };
506 if( ! $opt_X ){ # print bootstrap, unless XS is disabled
508 bootstrap $module \$VERSION;
512 if( $opt_P ){ # if POD is disabled
521 # Preloaded methods go here.
523 # Autoload methods go after $after, and are processed by the autosplit program.
529 $author = "A. U. Thor";
530 $email = 'a.u.thor@a.galaxy.far.far.away';
534 if (@const_names and not $opt_P) {
536 \n=head1 Exported constants
538 @{[join "\n ", @const_names]}
542 if (defined $fdecls and @$fdecls and not $opt_P) {
544 \n=head1 Exported functions
546 @{[join "\n ", @$fdecls]}
551 $pod = <<"END" unless $opt_P;
552 ## Below is the stub of documentation for your module. You better edit it!
556 #$module - Perl extension for blah blah blah
565 #Stub documentation for $module was created by h2xs. It looks like the
566 #author of the extension was negligent enough to leave the stub
570 #$const_doc$fdecl_doc
582 $pod =~ s/^\#//gm unless $opt_P;
583 print PM $pod unless $opt_P;
588 if( ! $opt_X ){ # print XS, unless it is disabled
589 warn "Writing $ext$modpname/$modfname.xs\n";
598 foreach my $path_h (@path_h) {
600 $h =~ s#^/usr/include/##;
601 if ($^O eq 'VMS') { $h =~ s#.*vms\]#sys/# or $h =~ s#.*[:>\]]##; }
602 print XS qq{#include <$h>\n};
612 croak("$module::%s not implemented on this architecture", s);
617 constant(char *name, int arg)
623 my(@AZ, @az, @under);
625 foreach(@const_names){
626 @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
627 @az = 'a' .. 'z' if !@az && /^[a-z]/;
628 @under = '_' if !@under && /^_/;
631 foreach $letter (@AZ, @az, @under) {
633 last if $letter eq 'a' && !@const_names;
635 print XS " case '$letter':\n";
637 while (substr($const_names[0],0,1) eq $letter) {
638 $name = shift(@const_names);
639 $macro = $prefix{$name} ? "$opt_p$name" : $name;
640 next if $const_xsub{$macro};
642 if (strEQ(name, "$name"))
667 $prefix = "PREFIX = $opt_p" if defined $opt_p;
668 # Now switch from C to XS by issuing the first MODULE declaration:
671 MODULE = $module PACKAGE = $module $prefix
675 foreach (sort keys %const_xsub) {
684 croak("Your vendor has not defined the $module macro $_");
693 # If a constant() function was written then output a corresponding
695 print XS <<"END" unless $opt_c;
710 my ($type, $name, $args) = @$decl;
711 return if $seen_decl{$name}++; # Need to do the same for docs as well?
713 my @argnames = map {$_->[1]} @$args;
714 my @argtypes = map { normalize_type( $_->[0] ) } @$args;
715 my @argarrays = map { $_->[4] || '' } @$args;
716 my $numargs = @$args;
717 if ($numargs and $argtypes[-1] eq '...') {
719 $argnames[-1] = '...';
722 $type = normalize_type($type);
730 for $arg (0 .. $numargs - 1) {
732 $argtypes[$arg] $argnames[$arg]$argarrays[$arg]
737 # Should be called before any actual call to normalize_type().
739 # We do not want to read ./typemap by obvios reasons.
740 my @tm = qw(../../../typemap ../../typemap ../typemap);
741 my $stdtypemap = "$Config::Config{privlib}/ExtUtils/typemap";
742 unshift @tm, $stdtypemap;
743 my $proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
746 foreach $typemap (@tm) {
747 next unless -e $typemap ;
748 # skip directories, binary files etc.
749 warn " Scanning $typemap\n";
750 warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
752 open(TYPEMAP, $typemap)
753 or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
754 my $mode = 'Typemap';
757 if (/^INPUT\s*$/) { $mode = 'Input'; next; }
758 elsif (/^OUTPUT\s*$/) { $mode = 'Output'; next; }
759 elsif (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; }
760 elsif ($mode eq 'Typemap') {
761 next if /^\s*($|\#)/ ;
762 if ( ($type, $image) =
763 /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/o
764 # This may reference undefined functions:
765 and not ($image eq 'T_PACKED' and $typemap eq $stdtypemap)) {
766 normalize_type($type);
770 close(TYPEMAP) or die "Cannot close $typemap: $!";
772 %std_types = %types_seen;
778 my $ignore_mods = '(?:\b(?:__const__|static|inline|__inline__)\b\s*)*';
780 $type =~ s/$ignore_mods//go;
781 $type =~ s/([\]\[()])/ \1 /g;
785 $type =~ s/\b\*/ */g;
786 $type =~ s/\*\b/* /g;
787 $type =~ s/\*\s+(?=\*)/*/g;
789 unless $type eq '...' or $type eq 'void' or $std_types{$type};
794 for $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) }
801 warn "Writing $ext$modpname/typemap\n";
802 open TM, ">typemap" or die "Cannot open typemap file for write: $!";
804 for $type (keys %types_seen) {
805 print TM $type, "\t" x (6 - int((length $type)/8)), "T_PTROBJ\n"
808 close TM or die "Cannot close typemap file for write: $!";
813 warn "Writing $ext$modpname/Makefile.PL\n";
814 open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
817 use ExtUtils::MakeMaker;
818 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
819 # the contents of the Makefile that is written.
821 print PL "WriteMakefile(\n";
822 print PL " 'NAME' => '$module',\n";
823 print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n";
824 if( ! $opt_X ){ # print C stuff, unless XS is disabled
825 print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
826 print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
827 print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
830 close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
832 warn "Writing $ext$modpname/test.pl\n";
833 open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
835 # Before `make install' is performed this script should be runnable with
836 # `make test'. After `make install' it should work as `perl test.pl'
838 ######################### We start with some black magic to print on failure.
840 # Change 1..1 below to 1..last_test_to_print .
841 # (It may become useful if the test is moved to ./t subdirectory.)
843 BEGIN { $| = 1; print "1..1\n"; }
844 END {print "not ok 1\n" unless $loaded;}
853 ######################### End of black magic.
855 # Insert your test code below (better if it prints "ok 13"
856 # (correspondingly "not ok 13") depending on the success of chunk 13
860 close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
862 warn "Writing $ext$modpname/Changes\n";
863 open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n";
864 print EX "Revision history for Perl extension $module.\n\n";
865 print EX "$TEMPLATE_VERSION ",scalar localtime,"\n";
866 print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n";
867 close(EX) || die "Can't close $ext$modpname/Changes: $!\n";
869 warn "Writing $ext$modpname/MANIFEST\n";
870 open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
873 eval {opendir(D,'.');};
874 unless ($@) { @files = readdir(D); closedir(D); }
876 if (!@files) { @files = map {chomp && $_} `ls`; }
879 # Clip trailing '.' for portability -- non-VMS OSs don't expect it
881 # Fix up for case-sensitive file systems
882 s/$modfname/$modfname/i && next;
883 $_ = "\U$_" if $_ eq 'manifest' or $_ eq 'changes';
884 $_ = 'Makefile.PL' if $_ eq 'makefile.pl';
887 print MANI join("\n",@files), "\n";
891 close OUT or die "Can't close $file: $!";
892 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
893 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';