h2xs.SH

   1 case $CONFIG in
   2 '')
   3         if test -f config.sh; then TOP=.;
   4         elif test -f ../config.sh; then TOP=..;
   5         elif test -f ../../config.sh; then TOP=../..;
   6         elif test -f ../../../config.sh; then TOP=../../..;
   7         elif test -f ../../../../config.sh; then TOP=../../../..;
   8         else
   9                 echo "Can't find config.sh."; exit 1
  10         fi
  11         . $TOP/config.sh
  12         ;;
  13 esac
  14 : This forces SH files to create target in same directory as SH file.
  15 : This is so that make depend always knows where to find SH derivatives.
  16 case "$0" in
  17 */*) cd `expr X$0 : 'X\(.*\)/'` ;;
  18 esac
  19 echo "Extracting h2xs (with variable substitutions)"
  20 $spitshell >h2xs <<!GROK!THIS!
  21 #!$bin/perl
  22 !GROK!THIS!
  23
  24 $spitshell >>h2xs <<'!NO!SUBS!'
  25
  26 =head1 NAME
  27
  28 h2xs - convert .h C header files to Perl extensions
  29
  30 =head1 SYNOPSIS
  31
  32 B<h2xs> [B<-Acfh>] [B<-n> module_name] [headerfile [extra_libraries]]
  33
  34 =head1 DESCRIPTION
  35
  36 I<h2xs> builds a Perl extension from any C header file.  The extension will
  37 include functions which can be used to retrieve the value of any #define
  38 statement which was in the C header.
  39
  40 The I<module_name> will be used for the name of the extension.  If
  41 module_name is not supplied then the name of the header file will be used,
  42 with the first character capitalized.
  43
  44 If the extension might need extra libraries, they should be included
  45 here.  The extension Makefile.PL will take care of checking whether
  46 the libraries actually exist and how they should be loaded.
  47 The extra libraries should be specified in the form -lm -lposix, etc,
  48 just as on the cc command line.  By default, the Makefile.PL will
  49 search through the library path determined by Configure.  That path
  50 can be augmented by including arguments of the form B<-L/another/library/path>
  51 in the extra-libraries argument.
  52
  53 =head1 OPTIONS
  54
  55 =over 5
  56
  57 =item B<-n> I<module_name>
  58
  59 Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
  60
  61 =item B<-f>
  62
  63 Allows an extension to be created for a header even if that header is
  64 not found in /usr/include.
  65
  66 =item B<-c>
  67
  68 Omit C<constant()> from the .xs file and corresponding specialised
  69 C<AUTOLOAD> from the .pm file.
  70
  71 =item B<-A>
  72
  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.
  75
  76 =back
  77
  78 =head1 EXAMPLES
  79
  80
  81         # Default behavior, extension is Rusers
  82         h2xs rpcsvc/rusers
  83
  84         # Same, but extension is RUSERS
  85         h2xs -n RUSERS rpcsvc/rusers
  86
  87         # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
  88         h2xs rpcsvc::rusers
  89
  90         # Extension is ONC::RPC.  Still finds <rpcsvc/rusers.h>
  91         h2xs -n ONC::RPC rpcsvc/rusers
  92
  93         # Without constant() or AUTOLOAD
  94         h2xs -c rpcsvc/rusers
  95
  96         # Creates templates for an extension named RPC
  97         h2xs -cfn RPC
  98
  99         # Extension is ONC::RPC.
 100         h2xs -cfn ONC::RPC
 101
 102         # Makefile.PL will look for library -lrpc in
 103         # additional directory /opt/net/lib
 104         h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
 105
 106
 107 =head1 ENVIRONMENT
 108
 109 No environment variables are used.
 110
 111 =head1 AUTHOR
 112
 113 Larry Wall and others
 114
 115 =head1 SEE ALSO
 116
 117 L<perl>, L<ExtUtils::MakeMaker>, L<AutoLoader>
 118
 119 =head1 DIAGNOSTICS
 120
 121 The usual warnings if it can't read or write the files involved.
 122
 123 =cut
 124
 125
 126 use Getopt::Std;
 127
 128 sub usage{
 129         warn "@_\n" if @_;
 130     die 'h2xs [-Acfh] [-n module_name] [headerfile [extra_libraries]]
 131     -f   Force creation of the extension even if the C header does not exist.
 132     -n   Specify a name to use for the extension (recommended).
 133     -c   Omit the constant() function and specialised AUTOLOAD from the XS file.
 134     -A   Omit all autoloading facilities (implies -c).
 135     -h   Display this help message
 136 extra_libraries
 137          are any libraries that might be needed for loading the
 138          extension, e.g. -lm would try to link in the math library.
 139 ';
 140 }
 141
 142
 143 getopts("Acfhn:") || usage;
 144
 145 usage if $opt_h;
 146 $opt_c = 1 if $opt_A;
 147
 148 $path_h    = shift;
 149 $extralibs = "@ARGV";
 150
 151 usage "Must supply header file or module name\n"
 152         unless ($path_h or $opt_n);
 153
 154
 155 if( $path_h ){
 156     $name = $path_h;
 157     if( $path_h =~ s#::#/#g && $opt_n ){
 158         warn "Nesting of headerfile ignored with -n\n";
 159     }
 160     $path_h .= ".h" unless $path_h =~ /\.h$/;
 161     $path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#;
 162     die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
 163
 164     # Scan the header file (we should deal with nested header files)
 165     # Record the names of simple #define constants into const_names
 166     # Function prototypes are not (currently) processed.
 167     open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
 168     while (<CH>) {
 169         if (/^#[ \t]*define\s+(\w+)\b\s*[^("]/) {
 170             $_ = $1;
 171             next if /^_.*_h_*$/i; # special case, but for what?
 172             $const_names{$_}++;
 173         }
 174     }
 175     close(CH);
 176     @const_names = sort keys %const_names;
 177 }
 178
 179
 180 $module = $opt_n || do {
 181         $name =~ s/\.h$//;
 182         if( $name !~ /::/ ){
 183                 $name =~ s#^.*/##;
 184                 $name = "\u$name";
 185         }
 186         $name;
 187 };
 188
 189 chdir 'ext' if -d 'ext';
 190
 191 if( $module =~ /::/ ){
 192         $nested = 1;
 193         @modparts = split(/::/,$module);
 194         $modfname = $modparts[-1];
 195         $modpname = join('/',@modparts);
 196 }
 197 else {
 198         $nested = 0;
 199         @modparts = ();
 200         $modfname = $modpname = $module;
 201 }
 202
 203
 204 die "Won't overwrite existing ext/$modpname\n" if -e $modpname;
 205 # quick hack, should really loop over @modparts
 206 mkdir($modparts[0], 0777) if $nested;
 207 mkdir($modpname, 0777);
 208 chdir($modpname) || die "Can't chdir ext/$modpname: $!\n";
 209
 210 open(XS, ">$modfname.xs") || die "Can't create ext/$modpname/$modfname.xs: $!\n";
 211 open(PM, ">$modfname.pm") || die "Can't create ext/$modpname/$modfname.pm: $!\n";
 212
 213 $" = "\n\t";
 214 warn "Writing ext/$modpname/$modfname.pm\n";
 215
 216 print PM <<"END";
 217 package $module;
 218
 219 require Exporter;
 220 require DynaLoader;
 221 END
 222
 223 if( ! $opt_A ){
 224         print PM <<"END";
 225 require AutoLoader;
 226 END
 227 }
 228
 229 if( $opt_c && ! $opt_A ){
 230         # we won't have our own AUTOLOAD(), so we'll inherit it.
 231         print PM <<"END";
 232
 233 \@ISA = qw(Exporter AutoLoader DynaLoader);
 234 END
 235 }
 236 else{
 237         # 1) we have our own AUTOLOAD(), so don't need to inherit it.
 238         # or
 239         # 2) we don't want autoloading mentioned.
 240         print PM <<"END";
 241
 242 \@ISA = qw(Exporter DynaLoader);
 243 END
 244 }
 245
 246 print PM<<"END";
 247 # Items to export into callers namespace by default. Note: do not export
 248 # names by default without a very good reason. Use EXPORT_OK instead.
 249 # Do not simply export all your public functions/methods/constants.
 250 \@EXPORT = qw(
 251         @const_names
 252 );
 253 END
 254
 255 print PM <<"END" unless $opt_c;
 256 sub AUTOLOAD {
 257     # This AUTOLOAD is used to 'autoload' constants from the constant()
 258     # XS function.  If a constant is not found then control is passed
 259     # to the AUTOLOAD in AutoLoader.
 260
 261     local(\$constname);
 262     (\$constname = \$AUTOLOAD) =~ s/.*:://;
 263     \$val = constant(\$constname, \@_ ? \$_[0] : 0);
 264     if (\$! != 0) {
 265         if (\$! =~ /Invalid/) {
 266             \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
 267             goto &AutoLoader::AUTOLOAD;
 268         }
 269         else {
 270             (\$pack,\$file,\$line) = caller;
 271             die "Your vendor has not defined $module macro \$constname, used at \$file line \$line.\n";
 272         }
 273     }
 274     eval "sub \$AUTOLOAD { \$val }";
 275     goto &\$AUTOLOAD;
 276 }
 277
 278 END
 279
 280 print PM <<"END";
 281 bootstrap $module;
 282
 283 # Preloaded methods go here.
 284
 285 # Autoload methods go after __END__, and are processed by the autosplit program.
 286
 287 1;
 288 __END__
 289 END
 290
 291 close PM;
 292
 293
 294 warn "Writing ext/$modpname/$modfname.xs\n";
 295
 296 print XS <<"END";
 297 #include "EXTERN.h"
 298 #include "perl.h"
 299 #include "XSUB.h"
 300
 301 END
 302 if( $path_h ){
 303         my($h) = $path_h;
 304         $h =~ s#^/usr/include/##;
 305 print XS <<"END";
 306 #include <$h>
 307
 308 END
 309 }
 310
 311 if( ! $opt_c ){
 312 print XS <<"END";
 313 static int
 314 not_here(s)
 315 char *s;
 316 {
 317     croak("$module::%s not implemented on this architecture", s);
 318     return -1;
 319 }
 320
 321 static double
 322 constant(name, arg)
 323 char *name;
 324 int arg;
 325 {
 326     errno = 0;
 327     switch (*name) {
 328 END
 329
 330 my(@AZ, @az, @under);
 331
 332 foreach(@const_names){
 333     @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
 334     @az = 'a' .. 'z' if !@az && /^[a-z]/;
 335     @under = '_'  if !@under && /^_/;
 336 }
 337
 338 foreach $letter (@AZ, @az, @under) {
 339
 340     last if $letter eq 'a' && !@const_names;
 341
 342     print XS "    case '$letter':\n";
 343     my($name);
 344     while (substr($const_names[0],0,1) eq $letter) {
 345         $name = shift(@const_names);
 346         print XS <<"END";
 347         if (strEQ(name, "$name"))
 348 #ifdef $name
 349             return $name;
 350 #else
 351             goto not_there;
 352 #endif
 353 END
 354     }
 355     print XS <<"END";
 356         break;
 357 END
 358 }
 359 print XS <<"END";
 360     }
 361     errno = EINVAL;
 362     return 0;
 363
 364 not_there:
 365     errno = ENOENT;
 366     return 0;
 367 }
 368
 369 END
 370 }
 371
 372 # Now switch from C to XS by issuing the first MODULE declaration:
 373 print XS <<"END";
 374
 375 MODULE = $module                PACKAGE = $module
 376
 377 END
 378
 379 # If a constant() function was written then output a corresponding
 380 # XS declaration:
 381 print XS <<"END" unless $opt_c;
 382
 383 double
 384 constant(name,arg)
 385         char *          name
 386         int             arg
 387
 388 END
 389
 390 close XS;
 391
 392
 393 warn "Writing ext/$modpname/Makefile.PL\n";
 394 open(PL, ">Makefile.PL") || die "Can't create ext/$modpname/Makefile.PL: $!\n";
 395
 396 print PL <<'END';
 397 use ExtUtils::MakeMaker;
 398 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
 399 # the contents of the Makefile that is written.
 400 END
 401 print PL "WriteMakefile(\n";
 402 print PL "    'NAME'    => '$module',\n";
 403 print PL "    'VERSION' => '0.1',\n";
 404 print PL "    'LIBS'    => ['$extralibs'],   # e.g., '-lm' \n";
 405 print PL "    'DEFINE'  => '',     # e.g., '-DHAVE_SOMETHING' \n";
 406 print PL "    'INC'     => '',     # e.g., '-I/usr/include/other' \n";
 407 print PL ");\n";
 408
 409
 410 system '/bin/ls > MANIFEST';
 411 !NO!SUBS!
 412 chmod 755 h2xs
 413 $eunicefix h2xs