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<-ACOPXcdf>] [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<use AutoLoader>> statement from the .pm file.
78 Omits creation of the F<Changes> file, and adds a HISTORY section to
83 Additional flags to specify to C preprocessor when scanning header for
84 function declarations. Should not be used without B<-x>.
88 Allows a pre-existing extension directory to be overwritten.
92 Omit the autogenerated stub POD section.
96 Omit the XS portion. Used to generate templates for a module which is not
97 XS-based. C<-c> and C<-f> are implicitly enabled.
101 Omit C<constant()> from the .xs file and corresponding specialised
102 C<AUTOLOAD> from the .pm file.
106 Turn on debugging messages.
110 Allows an extension to be created for a header even if that header is
111 not found in /usr/include.
115 Print the usage, help and version for this h2xs and exit.
117 =item B<-n> I<module_name>
119 Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
121 =item B<-p> I<prefix>
123 Specify a prefix which should be removed from the Perl function names, e.g., S<-p sec_rgy_>
124 This sets up the XS B<PREFIX> keyword and removes the prefix from functions that are
125 autoloaded via the C<constant()> mechanism.
127 =item B<-s> I<sub1,sub2>
129 Create a perl subroutine for the specified macros rather than autoload with the constant() subroutine.
130 These macros are assumed to have a return type of B<char *>, e.g., S<-s sec_rgy_wildcard_name,sec_rgy_wildcard_sid>.
132 =item B<-v> I<version>
134 Specify a version number for this extension. This version number is added
135 to the templates. The default is 0.01.
139 Automatically generate XSUBs basing on function declarations in the
140 header file. The package C<C::Scan> should be installed. If this
141 option is specified, the name of the header file may look like
142 C<NAME1,NAME2>. In this case NAME1 is used instead of the specified string,
143 but XSUBs are emitted only for the declarations included from file NAME2.
145 Note that some types of arguments/return-values for functions may
146 result in XSUB-declarations/typemap-entries which need
147 hand-editing. Such may be objects which cannot be converted from/to a
148 pointer (like C<long long>), pointers to functions, or arrays.
155 # Default behavior, extension is Rusers
158 # Same, but extension is RUSERS
159 h2xs -n RUSERS rpcsvc/rusers
161 # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
164 # Extension is ONC::RPC. Still finds <rpcsvc/rusers.h>
165 h2xs -n ONC::RPC rpcsvc/rusers
167 # Without constant() or AUTOLOAD
168 h2xs -c rpcsvc/rusers
170 # Creates templates for an extension named RPC
173 # Extension is ONC::RPC.
176 # Makefile.PL will look for library -lrpc in
177 # additional directory /opt/net/lib
178 h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
180 # Extension is DCE::rgynbase
181 # prefix "sec_rgy_" is dropped from perl function names
182 h2xs -n DCE::rgynbase -p sec_rgy_ dce/rgynbase
184 # Extension is DCE::rgynbase
185 # prefix "sec_rgy_" is dropped from perl function names
186 # subroutines are created for sec_rgy_wildcard_name and sec_rgy_wildcard_sid
187 h2xs -n DCE::rgynbase -p sec_rgy_ \
188 -s sec_rgy_wildcard_name,sec_rgy_wildcard_sid dce/rgynbase
190 # Make XS without defines in perl.h, but with function declarations
191 # visible from perl.h. Name of the extension is perl1.
192 # When scanning perl.h, define -DEXT=extern -DdEXT= -DINIT(x)=
193 # Extra backslashes below because the string is passed to shell.
194 # Note that a directory with perl header files would
195 # be added automatically to include path.
196 h2xs -xAn perl1 -F "-DEXT=extern -DdEXT= -DINIT\(x\)=" perl.h
198 # Same with function declaration in proto.h as visible from perl.h.
199 h2xs -xAn perl2 perl.h,proto.h
203 No environment variables are used.
207 Larry Wall and others
211 L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
215 The usual warnings if it cannot read or write the files involved.
219 my( $H2XS_VERSION ) = ' $Revision: 1.19 $ ' =~ /\$Revision:\s+([^\s]+)/;
220 my $TEMPLATE_VERSION = '0.01';
226 die "h2xs [-ACOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]]
227 version: $H2XS_VERSION
228 -A Omit all autoloading facilities (implies -c).
229 -C Omit creating the Changes file, add HISTORY heading to stub POD.
230 -F Additional flags for C preprocessor (used with -x).
231 -O Allow overwriting of a pre-existing extension directory.
232 -P Omit the stub POD section.
233 -X Omit the XS portion (implies both -c and -f).
234 -c Omit the constant() function and specialised AUTOLOAD from the XS file.
235 -d Turn on debugging messages.
236 -f Force creation of the extension even if the C header does not exist.
237 -h Display this help message
238 -n Specify a name to use for the extension (recommended).
239 -p Specify a prefix which should be removed from the Perl function names.
240 -s Create subroutines for specified macros.
241 -v Specify a version number for this extension.
242 -x Autogenerate XSUBs using C::Scan.
244 are any libraries that might be needed for loading the
245 extension, e.g. -lm would try to link in the math library.
250 getopts("ACF:OPXcdfhn:p:s:v:x") || usage;
255 $TEMPLATE_VERSION = $opt_v;
259 $opt_c = 1 if $opt_A;
261 # -X implies -c and -f
262 $opt_c = $opt_f = 1 if $opt_X;
264 %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s;
266 while (my $arg = shift) {
267 if ($arg =~ /^-l/i) {
268 $extralibs = "$arg @ARGV";
274 usage "Must supply header file or module name\n"
275 unless (@path_h or $opt_n);
279 foreach my $path_h (@path_h) {
281 if( $path_h =~ s#::#/#g && $opt_n ){
282 warn "Nesting of headerfile ignored with -n\n";
284 $path_h .= ".h" unless $path_h =~ /\.h$/;
286 $path_h =~ s/,.*$// if $opt_x;
287 if ($^O eq 'VMS') { # Consider overrides of default location
288 if ($path_h !~ m![:>\[]!) {
289 my($hadsys) = ($path_h =~ s!^sys/!!i);
290 if ($ENV{'DECC$System_Include'}) { $path_h = "DECC\$System_Include:$path_h"; }
291 elsif ($ENV{'DECC$Library_Include'}) { $path_h = "DECC\$Library_Include:$path_h"; }
292 elsif ($ENV{'GNU_CC_Include'}) { $path_h = 'GNU_CC_Include:' .
293 ($hadsys ? '[vms]' : '[000000]') . $path_h; }
294 elsif ($ENV{'VAXC$Include'}) { $path_h = "VAXC\$_Include:$path_h"; }
295 else { $path_h = "Sys\$Library:$path_h"; }
298 elsif ($^O eq 'os2') {
299 $path_h = "/usr/include/$path_h"
300 if $path_h !~ m#^([a-z]:)?[./]#i and -r "/usr/include/$path_h";
303 $path_h = "/usr/include/$path_h"
304 if $path_h !~ m#^[./]# and -r "/usr/include/$path_h";
308 die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
309 # Scan the header file (we should deal with nested header files)
310 # Record the names of simple #define constants into const_names
311 # Function prototypes are processed below.
312 open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
314 if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) {
315 print "Matched $_ ($1)\n" if $opt_d;
317 next if /^_.*_h_*$/i; # special case, but for what?
318 if (defined $opt_p) {
319 if (!/^$opt_p(\d)/) {
320 ++$prefix{$_} if s/^$opt_p//;
323 warn "can't remove $opt_p prefix from '$_'!\n";
332 @const_names = sort keys %const_names;
336 $module = $opt_n || do {
345 (chdir 'ext', $ext = 'ext/') if -d 'ext';
347 if( $module =~ /::/ ){
349 @modparts = split(/::/,$module);
350 $modfname = $modparts[-1];
351 $modpname = join('/',@modparts);
356 $modfname = $modpname = $module;
361 warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname;
363 die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
368 mkdir("$modpath$_", 0777);
372 mkdir($modpname, 0777);
373 chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
378 my $fdecls_parsed = [];
380 if( ! $opt_X ){ # use XS, unless it was disabled
381 open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
383 require C::Scan; # Run-time directive
384 require Config; # Run-time directive
385 warn "Scanning typemaps...\n";
389 foreach my $filename (@path_h) {
390 my $addflags = $opt_F || '';
391 if ($fullpath =~ /,/) {
395 warn "Scanning $filename for functions...\n";
396 $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter,
397 'add_cppflags' => $addflags;
398 $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]);
400 push @$fdecls_parsed, @{ $c->get('parsed_fdecls') };
401 push(@$fdecls, @{$c->get('fdecls')});
406 open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
409 warn "Writing $ext$modpname/$modfname.pm\n";
417 if( $opt_X || $opt_c || $opt_A ){
418 # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD
420 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
424 # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
428 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
437 print PM <<"END" if ! $opt_X; # use DynaLoader, unless XS was disabled
442 # Are we using AutoLoader or not?
443 unless ($opt_A) { # no autoloader whatsoever.
444 unless ($opt_c) { # we're doing the AUTOLOAD
445 print PM "use AutoLoader;\n";
448 print PM "use AutoLoader qw(AUTOLOAD);\n"
453 my $myISA = '@ISA = qw(Exporter'; # We seem to always want this.
454 $myISA .= ' DynaLoader' unless $opt_X; # no XS
456 print PM "\n$myISA\n\n";
459 # Items to export into callers namespace by default. Note: do not export
460 # names by default without a very good reason. Use EXPORT_OK instead.
461 # Do not simply export all your public functions/methods/constants.
465 \$VERSION = '$TEMPLATE_VERSION';
469 print PM <<"END" unless $opt_c or $opt_X;
471 # This AUTOLOAD is used to 'autoload' constants from the constant()
472 # XS function. If a constant is not found then control is passed
473 # to the AUTOLOAD in AutoLoader.
476 (\$constname = \$AUTOLOAD) =~ s/.*:://;
477 croak "&$module::constant not defined" if \$constname eq 'constant';
478 my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
480 if (\$! =~ /Invalid/ || \$!{EINVAL}) {
481 \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
482 goto &AutoLoader::AUTOLOAD;
485 croak "Your vendor has not defined $module macro \$constname";
489 *\$AUTOLOAD = sub () { \$val };
495 if( ! $opt_X ){ # print bootstrap, unless XS is disabled
497 bootstrap $module \$VERSION;
501 if( $opt_P ){ # if POD is disabled
510 # Preloaded methods go here.
513 print PM <<"END" unless $opt_A;
515 # Autoload methods go after $after, and are processed by the autosplit program.
524 $author = "A. U. Thor";
525 $email = 'a.u.thor@a.galaxy.far.far.away';
528 $revhist = <<EOT if $opt_C;
534 =item $TEMPLATE_VERSION
536 Original version; created by h2xs $H2XS_VERSION
544 if (@const_names and not $opt_P) {
546 \n=head2 Exported constants
548 @{[join "\n ", @const_names]}
552 if (defined $fdecls and @$fdecls and not $opt_P) {
554 \n=head2 Exported functions
556 @{[join "\n ", @$fdecls]}
561 $pod = <<"END" unless $opt_P;
562 ## Below is the stub of documentation for your module. You better edit it!
566 #$module - Perl extension for blah blah blah
575 #Stub documentation for $module was created by h2xs. It looks like the
576 #author of the extension was negligent enough to leave the stub
580 #$const_doc$fdecl_doc$revhist
592 $pod =~ s/^\#//gm unless $opt_P;
593 print PM $pod unless $opt_P;
598 if( ! $opt_X ){ # print XS, unless it is disabled
599 warn "Writing $ext$modpname/$modfname.xs\n";
608 foreach my $path_h (@path_h) {
610 $h =~ s#^/usr/include/##;
611 if ($^O eq 'VMS') { $h =~ s#.*vms\]#sys/# or $h =~ s#.*[:>\]]##; }
612 print XS qq{#include <$h>\n};
622 croak("$module::%s not implemented on this architecture", s);
627 constant(char *name, int arg)
633 my(@AZ, @az, @under);
635 foreach(@const_names){
636 @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
637 @az = 'a' .. 'z' if !@az && /^[a-z]/;
638 @under = '_' if !@under && /^_/;
641 foreach $letter (@AZ, @az, @under) {
643 last if $letter eq 'a' && !@const_names;
645 print XS " case '$letter':\n";
647 while (substr($const_names[0],0,1) eq $letter) {
648 $name = shift(@const_names);
649 $macro = $prefix{$name} ? "$opt_p$name" : $name;
650 next if $const_xsub{$macro};
652 if (strEQ(name, "$name"))
677 $prefix = "PREFIX = $opt_p" if defined $opt_p;
678 # Now switch from C to XS by issuing the first MODULE declaration:
681 MODULE = $module PACKAGE = $module $prefix
685 foreach (sort keys %const_xsub) {
694 croak("Your vendor has not defined the $module macro $_");
703 # If a constant() function was written then output a corresponding
705 print XS <<"END" unless $opt_c;
720 my ($type, $name, $args) = @$decl;
721 return if $seen_decl{$name}++; # Need to do the same for docs as well?
723 my @argnames = map {$_->[1]} @$args;
724 my @argtypes = map { normalize_type( $_->[0] ) } @$args;
725 my @argarrays = map { $_->[4] || '' } @$args;
726 my $numargs = @$args;
727 if ($numargs and $argtypes[-1] eq '...') {
729 $argnames[-1] = '...';
732 $type = normalize_type($type);
740 for $arg (0 .. $numargs - 1) {
742 $argtypes[$arg] $argnames[$arg]$argarrays[$arg]
747 # Should be called before any actual call to normalize_type().
749 # We do not want to read ./typemap by obvios reasons.
750 my @tm = qw(../../../typemap ../../typemap ../typemap);
751 my $stdtypemap = "$Config::Config{privlib}/ExtUtils/typemap";
752 unshift @tm, $stdtypemap;
753 my $proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
756 foreach $typemap (@tm) {
757 next unless -e $typemap ;
758 # skip directories, binary files etc.
759 warn " Scanning $typemap\n";
760 warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
762 open(TYPEMAP, $typemap)
763 or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
764 my $mode = 'Typemap';
767 if (/^INPUT\s*$/) { $mode = 'Input'; next; }
768 elsif (/^OUTPUT\s*$/) { $mode = 'Output'; next; }
769 elsif (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; }
770 elsif ($mode eq 'Typemap') {
771 next if /^\s*($|\#)/ ;
772 if ( ($type, $image) =
773 /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/o
774 # This may reference undefined functions:
775 and not ($image eq 'T_PACKED' and $typemap eq $stdtypemap)) {
776 normalize_type($type);
780 close(TYPEMAP) or die "Cannot close $typemap: $!";
782 %std_types = %types_seen;
788 my $ignore_mods = '(?:\b(?:__const__|static|inline|__inline__)\b\s*)*';
790 $type =~ s/$ignore_mods//go;
791 $type =~ s/([\]\[()])/ \1 /g;
795 $type =~ s/\b\*/ */g;
796 $type =~ s/\*\b/* /g;
797 $type =~ s/\*\s+(?=\*)/*/g;
799 unless $type eq '...' or $type eq 'void' or $std_types{$type};
804 for $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) }
811 warn "Writing $ext$modpname/typemap\n";
812 open TM, ">typemap" or die "Cannot open typemap file for write: $!";
814 for $type (keys %types_seen) {
815 print TM $type, "\t" x (6 - int((length $type)/8)), "T_PTROBJ\n"
818 close TM or die "Cannot close typemap file for write: $!";
823 warn "Writing $ext$modpname/Makefile.PL\n";
824 open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n";
827 use ExtUtils::MakeMaker;
828 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
829 # the contents of the Makefile that is written.
831 print PL "WriteMakefile(\n";
832 print PL " 'NAME' => '$module',\n";
833 print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n";
834 if( ! $opt_X ){ # print C stuff, unless XS is disabled
835 print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n";
836 print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n";
837 print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n";
840 close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n";
842 warn "Writing $ext$modpname/test.pl\n";
843 open(EX, ">test.pl") || die "Can't create $ext$modpname/test.pl: $!\n";
845 # Before `make install' is performed this script should be runnable with
846 # `make test'. After `make install' it should work as `perl test.pl'
848 ######################### We start with some black magic to print on failure.
850 # Change 1..1 below to 1..last_test_to_print .
851 # (It may become useful if the test is moved to ./t subdirectory.)
853 BEGIN { $| = 1; print "1..1\n"; }
854 END {print "not ok 1\n" unless $loaded;}
863 ######################### End of black magic.
865 # Insert your test code below (better if it prints "ok 13"
866 # (correspondingly "not ok 13") depending on the success of chunk 13
870 close(EX) || die "Can't close $ext$modpname/test.pl: $!\n";
873 warn "Writing $ext$modpname/Changes\n";
874 open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n";
875 print EX "Revision history for Perl extension $module.\n\n";
876 print EX "$TEMPLATE_VERSION ",scalar localtime,"\n";
877 print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n";
878 close(EX) || die "Can't close $ext$modpname/Changes: $!\n";
881 warn "Writing $ext$modpname/MANIFEST\n";
882 open(MANI,'>MANIFEST') or die "Can't create MANIFEST: $!";
885 eval {opendir(D,'.');};
886 unless ($@) { @files = readdir(D); closedir(D); }
888 if (!@files) { @files = map {chomp && $_} `ls`; }
891 # Clip trailing '.' for portability -- non-VMS OSs don't expect it
893 # Fix up for case-sensitive file systems
894 s/$modfname/$modfname/i && next;
895 $_ = "\U$_" if $_ eq 'manifest' or $_ eq 'changes';
896 $_ = 'Makefile.PL' if $_ eq 'makefile.pl';
899 print MANI join("\n",@files), "\n";
903 close OUT or die "Can't close $file: $!";
904 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
905 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';