h2xs

   1 #!/usr/bin/perl
   2 'di ';
   3 'ds 00 \"';
   4 'ig 00 ';
   5
   6 use Getopt::Std;
   7
   8 $usage='h2xs [-Aachfm] [-n module_name] [headerfile [extra_libraries]]
   9         -a      Omit AutoLoad facilities from .pm file.
  10         -c      Omit the constant() function from the XS file.
  11         -A      Equivalent to -a -c
  12         -f      Force creation of the extension even if the C header does not exist.
  13         -h      help
  14         -n      Specify a name to use for the extension.
  15 extra_libraries are any libraries that might be needed for loading
  16         the extension, e.g. -lm would try to link in the math library.
  17 ';
  18
  19 sub usage{ die "Usage: $usage\n" }
  20
  21 getopts("fhcaAn:") || &usage;
  22
  23 &usage if $opt_h;
  24
  25 if( @ARGV ){
  26         $path_h = shift;
  27 }
  28 elsif( ! @ARGV && ! $opt_n ){
  29         die "Must supply header file or module name\n";
  30 }
  31
  32 $extralibs = "@ARGV";
  33 if( $opt_A ){
  34         $opt_a = $opt_c = 1;
  35 }
  36
  37 if( $path_h ){
  38         $name = $path_h;
  39         if( $path_h =~ s#::#/#g && $opt_n ){
  40                 warn "Nesting of headerfile ignored with -n\n";
  41         }
  42         $path_h .= ".h" unless $path_h =~ /\.h$/;
  43         $path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#;
  44         die "Can't find $path_h\n" if( ! $opt_f && ! -f $path_h );
  45 }
  46
  47 $module = $opt_n || do {
  48         $name =~ s/\.h$//;
  49         if( $name !~ /::/ ){
  50                 $name =~ s#^.*/##;
  51                 $name = "\u$name";
  52         }
  53         $name;
  54 };
  55
  56 chdir 'ext' if -d 'ext';
  57
  58 if( $module =~ /::/ ){
  59         $nested = 1;
  60         @modparts = split(/::/,$module);
  61         $modfname = $modparts[-1];
  62         $modpname = join('/',@modparts);
  63 }
  64 else {
  65         $nested = 0;
  66         @modparts = ();
  67         $modfname = $modpname = $module;
  68 }
  69
  70
  71 die "Won't overwrite existing ext/$modpname\n" if -e $modpname;
  72 # quick hack, should really loop over @modparts
  73 mkdir($modparts[0], 0777) if $nested;
  74 mkdir($modpname, 0777);
  75 chdir($modpname) || die "Can't chdir ext/$modpname: $!\n";
  76
  77 open(XS, ">$modfname.xs") || die "Can't create ext/$modpname/$modfname.xs: $!\n";
  78 open(PM, ">$modfname.pm") || die "Can't create ext/$modpname/$modfname.pm: $!\n";
  79
  80
  81 if( -r $path_h ){
  82     open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
  83     while (<CH>) {
  84         if (/^#[ \t]*define\s+(\w+)\b\s*[^("]/) {
  85             $_ = $1;
  86             next if /^_.*_h_*$/i;
  87             $names{$_}++;
  88             @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/;
  89             @az = 'a' .. 'z' if !@az && /^[a-z]/;
  90             @under = '_' if !@under && /^_/;
  91         }
  92     }
  93     close(CH);
  94     @names = sort keys %names;
  95 }
  96
  97 $" = "\n\t";
  98 warn "Writing ext/$modpname/$modfname.pm\n";
  99
 100 if( ! $opt_a ){
 101 print PM <<"END";
 102 package $module;
 103
 104 require Exporter;
 105 require AutoLoader;
 106 require DynaLoader;
 107 \@ISA = qw(Exporter AutoLoader DynaLoader);
 108 # Items to export into callers namespace by default
 109 # (move infrequently used names to \@EXPORT_OK below)
 110 \@EXPORT = qw(
 111         @names
 112 );
 113 # Other items we are prepared to export if requested
 114 \@EXPORT_OK = qw(
 115 );
 116
 117 sub AUTOLOAD {
 118     if (\@_ > 1) {
 119         \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
 120         goto &AutoLoader::AUTOLOAD;
 121     }
 122     local(\$constname);
 123     (\$constname = \$AUTOLOAD) =~ s/.*:://;
 124     \$val = constant(\$constname, \@_ ? \$_[0] : 0);
 125     if (\$! != 0) {
 126         if (\$! =~ /Invalid/) {
 127             \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
 128             goto &AutoLoader::AUTOLOAD;
 129         }
 130         else {
 131             (\$pack,\$file,\$line) = caller;
 132             die "Your vendor has not defined $module macro \$constname, used at \$file line \$line.\n";
 133         }
 134     }
 135     eval "sub \$AUTOLOAD { \$val }";
 136     goto &\$AUTOLOAD;
 137 }
 138
 139 bootstrap $module;
 140
 141 # Preloaded methods go here.  Autoload methods go after __END__, and are
 142 # processed by the autosplit program.
 143
 144 1;
 145 __END__
 146 END
 147 }
 148 else{
 149 print PM <<"END";
 150 package $module;
 151
 152 require Exporter;
 153 require DynaLoader;
 154 \@ISA = qw(Exporter DynaLoader);
 155 # Items to export into callers namespace by default
 156 \@EXPORT = qw();
 157 # Other items we are prepared to export if requested
 158 \@EXPORT_OK = qw();
 159
 160
 161 bootstrap $module;
 162
 163 1;
 164 END
 165 }
 166
 167 close PM;
 168
 169 warn "Writing ext/$modpname/$modfname.xs\n";
 170 print XS <<"END";
 171 #include "EXTERN.h"
 172 #include "perl.h"
 173 #include "XSUB.h"
 174
 175 END
 176 if( $path_h ){
 177         my($h) = $path_h;
 178         $h =~ s#^/usr/include/##;
 179 print XS <<"END";
 180 #include <$h>
 181
 182 END
 183 }
 184
 185 if( ! $opt_c ){
 186 print XS <<"END";
 187 static int
 188 not_here(s)
 189 char *s;
 190 {
 191     croak("$module::%s not implemented on this architecture", s);
 192     return -1;
 193 }
 194
 195 static double
 196 constant(name, arg)
 197 char *name;
 198 int arg;
 199 {
 200     errno = 0;
 201     switch (*name) {
 202 END
 203
 204 foreach $letter (@AZ, @az, @under) {
 205
 206     last if $letter eq 'a' && !@names;
 207
 208     print XS "    case '$letter':\n";
 209     my($name);
 210     while (substr($names[0],0,1) eq $letter) {
 211         $name = shift(@names);
 212         print XS <<"END";
 213         if (strEQ(name, "$name"))
 214 #ifdef $name
 215             return $name;
 216 #else
 217             goto not_there;
 218 #endif
 219 END
 220     }
 221     print XS <<"END";
 222         break;
 223 END
 224 }
 225 print XS <<"END";
 226     }
 227     errno = EINVAL;
 228     return 0;
 229
 230 not_there:
 231     errno = ENOENT;
 232     return 0;
 233 }
 234
 235
 236 MODULE = $module                PACKAGE = $module
 237
 238 double
 239 constant(name,arg)
 240         char *          name
 241         int             arg
 242
 243 END
 244 }
 245 else{
 246 print XS <<"END";
 247
 248 MODULE = $module                PACKAGE = $module
 249
 250 END
 251 }
 252
 253 close XS;
 254
 255 {
 256 warn "Writing ext/$modpname/Makefile.PL\n";
 257 open(PL, ">Makefile.PL") || die "Can't create ext/$modpname/Makefile.PL: $!\n";
 258
 259 print PL <<'END';
 260 use ExtUtils::MakeMaker;
 261 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
 262 # the contents of the Makefile that is written.
 263 END
 264 print PL "WriteMakefile(\n";
 265 print PL "    'NAME'    => '$module',\n";
 266 print PL "    'VERSION' => '0.1',\n";
 267 print PL "    'LIBS'    => ['$extralibs'],   # e.g., '-lm' \n";
 268 print PL "    'DEFINE'  => '',     # e.g., '-DHAVE_SOMETHING' \n";
 269 print PL "    'INC'     => '',     # e.g., '-I/usr/include/other' \n";
 270 print PL ");\n";
 271 }
 272
 273 system '/bin/ls > MANIFEST';
 274
 275
 276 ##############################################################################
 277
 278         # These next few lines are legal in both Perl and nroff.
 279
 280 .00 ;                   # finish .ig
 281
 282 'di                     \" finish diversion--previous line must be blank
 283 .nr nl 0-1              \" fake up transition to first page again
 284 .nr % 0                 \" start at page 1
 285 '; __END__ ############# From here on it's a standard manual page ############
 286 .TH H2XS 1 "August 9, 1994"
 287 .AT 3
 288 .SH NAME
 289 h2xs \- convert .h C header files to Perl extensions
 290 .SH SYNOPSIS
 291 .B h2xs [-Aachfm] [-n module_name] [headerfile [extra_libraries]]
 292 .SH DESCRIPTION
 293 .I h2xs
 294 builds a Perl extension from any C header file.  The extension will include
 295 functions which can be used to retrieve the value of any #define statement
 296 which was in the C header.
 297 .PP
 298 The
 299 .I module_name
 300 will be used for the name of the extension.  If module_name is not supplied
 301 then the name of the header file will be used, with the first character
 302 capitalized.
 303 .PP
 304 If the extension might need extra libraries, they should be included
 305 here.  The extension Makefile.PL will take care of checking whether
 306 the libraries actually exist and how they should be loaded.
 307 The extra libraries should be specified in the form -lm -lposix, etc,
 308 just as on the cc command line.  By default, the Makefile.PL will
 309 search through the library path determined by Configure.  That path
 310 can be augmented by including arguments of the form -L/another/library/path
 311 in the extra-libraries argument.
 312 .SH OPTIONS
 313 .TP
 314 .B \-f
 315 Allows an extension to be created for a header even if that
 316 header is not found in /usr/include.
 317 .TP
 318 .B \-a
 319 Omit AutoLoad(), AUTOLOAD, and autosplit from the .pm and Makefile files.
 320 .TP
 321 .B \-c
 322 Omit constant() from the .xs file.
 323 .TP
 324 .B \-n module_name
 325 Specifies a name to be used for the extension.
 326 .TP
 327 .B \-A
 328 Turns on both -a and -c.
 329 .SH EXAMPLES
 330 .nf
 331
 332         # Default behavior, extension is Rusers
 333         h2xs rpcsvc/rusers
 334
 335         # Same, but extension is RUSERS
 336         h2xs -n RUSERS rpcsvc/rusers
 337
 338         # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
 339         h2xs rpcsvc::rusers
 340
 341         # Extension is ONC::RPC.  Still finds <rpcsvc/rusers.h>
 342         h2xs -n ONC::RPC rpcsvc/rusers
 343
 344         # Without AUTOLOAD, AutoLoad, autosplit
 345         h2xs -a rpcsvc/rusers
 346
 347         # Creates templates for an extension named RPC
 348         h2xs -Afn RPC
 349
 350         # Extension is ONC::RPC.
 351         h2xs -An ONC::RPC
 352
 353         # Makefile.PL will look for library -lrpc in
 354         # additional directory /opt/net/lib
 355         h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
 356
 357 .fi
 358 .SH ENVIRONMENT
 359 No environment variables are used.
 360 .SH AUTHOR
 361 Larry Wall
 362 .SH "SEE ALSO"
 363 perl(1) ExtUtils::MakeMaker
 364 .SH DIAGNOSTICS
 365 The usual warnings if it can't read or write the files involved.
 366 .ex