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 # Other items we are prepared to export if requested
 254 \@EXPORT_OK = qw(
 255 );
 256
 257 END
 258
 259 print PM <<"END" unless $opt_c;
 260 sub AUTOLOAD {
 261     # This AUTOLOAD is used to 'autoload' constants from the constant()
 262     # XS function.  If a constant is not found then control is passed
 263     # to the AUTOLOAD in AutoLoader.
 264
 265     # NOTE: THIS AUTOLOAD FUNCTION IS FLAWED (but is the best we can do for now).
 266     # Avoid old-style ``&CONST'' usage. Either remove the ``&'' or add ``()''.
 267     if (\@_ > 0) {
 268         \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
 269         goto &AutoLoader::AUTOLOAD;
 270     }
 271     local(\$constname);
 272     (\$constname = \$AUTOLOAD) =~ s/.*:://;
 273     \$val = constant(\$constname, \@_ ? \$_[0] : 0);
 274     if (\$! != 0) {
 275         if (\$! =~ /Invalid/) {
 276             \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
 277             goto &AutoLoader::AUTOLOAD;
 278         }
 279         else {
 280             (\$pack,\$file,\$line) = caller;
 281             die "Your vendor has not defined $module macro \$constname, used at \$file line \$line.\n";
 282         }
 283     }
 284     eval "sub \$AUTOLOAD { \$val }";
 285     goto &\$AUTOLOAD;
 286 }
 287
 288 END
 289
 290 print PM <<"END";
 291 bootstrap $module;
 292
 293 # Preloaded methods go here.
 294
 295 # Autoload methods go after __END__, and are processed by the autosplit program.
 296
 297 1;
 298 __END__
 299 END
 300
 301 close PM;
 302
 303
 304 warn "Writing ext/$modpname/$modfname.xs\n";
 305
 306 print XS <<"END";
 307 #include "EXTERN.h"
 308 #include "perl.h"
 309 #include "XSUB.h"
 310
 311 END
 312 if( $path_h ){
 313         my($h) = $path_h;
 314         $h =~ s#^/usr/include/##;
 315 print XS <<"END";
 316 #include <$h>
 317
 318 END
 319 }
 320
 321 if( ! $opt_c ){
 322 print XS <<"END";
 323 static int
 324 not_here(s)
 325 char *s;
 326 {
 327     croak("$module::%s not implemented on this architecture", s);
 328     return -1;
 329 }
 330
 331 static double
 332 constant(name, arg)
 333 char *name;
 334 int arg;
 335 {
 336     errno = 0;
 337     switch (*name) {
 338 END
 339
 340 my(@AZ, @az, @under);
 341
 342 foreach(@const_names){
 343     @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
 344     @az = 'a' .. 'z' if !@az && /^[a-z]/;
 345     @under = '_'  if !@under && /^_/;
 346 }
 347
 348 foreach $letter (@AZ, @az, @under) {
 349
 350     last if $letter eq 'a' && !@const_names;
 351
 352     print XS "    case '$letter':\n";
 353     my($name);
 354     while (substr($const_names[0],0,1) eq $letter) {
 355         $name = shift(@const_names);
 356         print XS <<"END";
 357         if (strEQ(name, "$name"))
 358 #ifdef $name
 359             return $name;
 360 #else
 361             goto not_there;
 362 #endif
 363 END
 364     }
 365     print XS <<"END";
 366         break;
 367 END
 368 }
 369 print XS <<"END";
 370     }
 371     errno = EINVAL;
 372     return 0;
 373
 374 not_there:
 375     errno = ENOENT;
 376     return 0;
 377 }
 378
 379 END
 380 }
 381
 382 # Now switch from C to XS by issuing the first MODULE declaration:
 383 print XS <<"END";
 384
 385 MODULE = $module                PACKAGE = $module
 386
 387 END
 388
 389 # If a constant() function was written then output a corresponding
 390 # XS declaration:
 391 print XS <<"END" unless $opt_c;
 392
 393 double
 394 constant(name,arg)
 395         char *          name
 396         int             arg
 397
 398 END
 399
 400 close XS;
 401
 402
 403 warn "Writing ext/$modpname/Makefile.PL\n";
 404 open(PL, ">Makefile.PL") || die "Can't create ext/$modpname/Makefile.PL: $!\n";
 405
 406 print PL <<'END';
 407 use ExtUtils::MakeMaker;
 408 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
 409 # the contents of the Makefile that is written.
 410 END
 411 print PL "WriteMakefile(\n";
 412 print PL "    'NAME'    => '$module',\n";
 413 print PL "    'VERSION' => '0.1',\n";
 414 print PL "    'LIBS'    => ['$extralibs'],   # e.g., '-lm' \n";
 415 print PL "    'DEFINE'  => '',     # e.g., '-DHAVE_SOMETHING' \n";
 416 print PL "    'INC'     => '',     # e.g., '-I/usr/include/other' \n";
 417 print PL ");\n";
 418
 419
 420 system '/bin/ls > MANIFEST';
 421 !NO!SUBS!
 422 chmod 755 h2xs
 423 $eunicefix h2xs