home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / SLAKWARE / D12 / PERL1.TGZ / perl1.tar / usr / bin / h2xs < prev    next >
Text File  |  1996-06-28  |  13KB  |  582 lines
  1. #!/usr/bin/perl
  2.     eval 'exec perl -S $0 "$@"'
  3.     if 0;
  4.  
  5. =head1 NAME
  6.  
  7. h2xs - convert .h C header files to Perl extensions
  8.  
  9. =head1 SYNOPSIS
  10.  
  11. B<h2xs> [B<-AOPXcf>] [B<-v> version] [B<-n> module_name] [headerfile [extra_libraries]]
  12.  
  13. B<h2xs> B<-h>
  14.  
  15. =head1 DESCRIPTION
  16.  
  17. I<h2xs> builds a Perl extension from any C header file.  The extension will
  18. include functions which can be used to retrieve the value of any #define
  19. statement which was in the C header.
  20.  
  21. The I<module_name> will be used for the name of the extension.  If
  22. module_name is not supplied then the name of the header file will be used,
  23. with the first character capitalized.
  24.  
  25. If the extension might need extra libraries, they should be included
  26. here.  The extension Makefile.PL will take care of checking whether
  27. the libraries actually exist and how they should be loaded.
  28. The extra libraries should be specified in the form -lm -lposix, etc,
  29. just as on the cc command line.  By default, the Makefile.PL will
  30. search through the library path determined by Configure.  That path
  31. can be augmented by including arguments of the form B<-L/another/library/path>
  32. in the extra-libraries argument.
  33.  
  34. =head1 OPTIONS
  35.  
  36. =over 5
  37.  
  38. =item B<-A>
  39.  
  40. Omit all autoload facilities.  This is the same as B<-c> but also removes the
  41. S<C<require AutoLoader>> statement from the .pm file.
  42.  
  43. =item B<-O>
  44.  
  45. Allows a pre-existing extension directory to be overwritten.
  46.  
  47. =item B<-P>
  48.  
  49. Omit the autogenerated stub POD section. 
  50.  
  51. =item B<-c>
  52.  
  53. Omit C<constant()> from the .xs file and corresponding specialised
  54. C<AUTOLOAD> from the .pm file.
  55.  
  56. =item B<-f>
  57.  
  58. Allows an extension to be created for a header even if that header is
  59. not found in /usr/include.
  60.  
  61. =item B<-h>
  62.  
  63. Print the usage, help and version for this h2xs and exit.
  64.  
  65. =item B<-n> I<module_name>
  66.  
  67. Specifies a name to be used for the extension, e.g., S<-n RPC::DCE>
  68.  
  69. =item B<-v> I<version>
  70.  
  71. Specify a version number for this extension.  This version number is added
  72. to the templates.  The default is 0.01.
  73.  
  74. =item B<-X>
  75.  
  76. Omit the XS portion.  Used to generate templates for a module which is not
  77. XS-based.
  78.  
  79. =back
  80.  
  81. =head1 EXAMPLES
  82.  
  83.  
  84.     # Default behavior, extension is Rusers
  85.     h2xs rpcsvc/rusers
  86.  
  87.     # Same, but extension is RUSERS
  88.     h2xs -n RUSERS rpcsvc/rusers
  89.  
  90.     # Extension is rpcsvc::rusers. Still finds <rpcsvc/rusers.h>
  91.     h2xs rpcsvc::rusers
  92.  
  93.     # Extension is ONC::RPC.  Still finds <rpcsvc/rusers.h>
  94.     h2xs -n ONC::RPC rpcsvc/rusers
  95.  
  96.     # Without constant() or AUTOLOAD
  97.     h2xs -c rpcsvc/rusers
  98.  
  99.     # Creates templates for an extension named RPC
  100.     h2xs -cfn RPC
  101.  
  102.     # Extension is ONC::RPC.
  103.     h2xs -cfn ONC::RPC
  104.  
  105.     # Makefile.PL will look for library -lrpc in 
  106.     # additional directory /opt/net/lib
  107.     h2xs rpcsvc/rusers -L/opt/net/lib -lrpc
  108.  
  109.  
  110. =head1 ENVIRONMENT
  111.  
  112. No environment variables are used.
  113.  
  114. =head1 AUTHOR
  115.  
  116. Larry Wall and others
  117.  
  118. =head1 SEE ALSO
  119.  
  120. L<perl>, L<perlxstut>, L<ExtUtils::MakeMaker>, and L<AutoLoader>.
  121.  
  122. =head1 DIAGNOSTICS
  123.  
  124. The usual warnings if it can't read or write the files involved.
  125.  
  126. =cut
  127.  
  128. my( $H2XS_VERSION ) = '$Revision: 1.16 $' =~ /\$Revision:\s+([^\s]+)/;
  129. my $TEMPLATE_VERSION = '0.01';
  130.  
  131. use Getopt::Std;
  132.  
  133. sub usage{
  134.     warn "@_\n" if @_;
  135.     die "h2xs [-AOPXcfh] [-v version] [-n module_name] [headerfile [extra_libraries]]
  136. version: $H2XS_VERSION
  137.     -f   Force creation of the extension even if the C header does not exist.
  138.     -n   Specify a name to use for the extension (recommended).
  139.     -c   Omit the constant() function and specialised AUTOLOAD from the XS file.
  140.     -A   Omit all autoloading facilities (implies -c).
  141.     -O   Allow overwriting of a pre-existing extension directory.
  142.     -P   Omit the stub POD section.
  143.     -X   Omit the XS portion.
  144.     -v   Specify a version number for this extension.
  145.     -h   Display this help message
  146. extra_libraries
  147.          are any libraries that might be needed for loading the
  148.          extension, e.g. -lm would try to link in the math library.
  149. ";
  150. }
  151.  
  152.  
  153. getopts("AOPXcfhv:n:") || usage;
  154.  
  155. usage if $opt_h;
  156.  
  157. if( $opt_v ){
  158.     $TEMPLATE_VERSION = $opt_v;
  159. }
  160. $opt_c = 1 if $opt_A;
  161.  
  162. $path_h    = shift;
  163. $extralibs = "@ARGV";
  164.  
  165. usage "Must supply header file or module name\n"
  166.     unless ($path_h or $opt_n);
  167.  
  168.  
  169. if( $path_h ){
  170.     $name = $path_h;
  171.     if( $path_h =~ s#::#/#g && $opt_n ){
  172.     warn "Nesting of headerfile ignored with -n\n";
  173.     }
  174.     $path_h .= ".h" unless $path_h =~ /\.h$/;
  175.     $path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#;
  176.     die "Can't find $path_h\n" if ( ! $opt_f && ! -f $path_h );
  177.  
  178.     # Scan the header file (we should deal with nested header files)
  179.     # Record the names of simple #define constants into const_names
  180.     # Function prototypes are not (currently) processed.
  181.     open(CH, "<$path_h") || die "Can't open $path_h: $!\n";
  182.     while (<CH>) {
  183.     if (/^#[ \t]*define\s+(\w+)\b\s*[^("]/) {
  184.         $_ = $1;
  185.         next if /^_.*_h_*$/i; # special case, but for what?
  186.         $const_names{$_}++;
  187.     }
  188.     }
  189.     close(CH);
  190.     @const_names = sort keys %const_names;
  191. }
  192.  
  193.  
  194. $module = $opt_n || do {
  195.     $name =~ s/\.h$//;
  196.     if( $name !~ /::/ ){
  197.         $name =~ s#^.*/##;
  198.         $name = "\u$name";
  199.     }
  200.     $name;
  201. };
  202.  
  203. (chdir 'ext', $ext = 'ext/') if -d 'ext';
  204.  
  205. if( $module =~ /::/ ){
  206.     $nested = 1;
  207.     @modparts = split(/::/,$module);
  208.     $modfname = $modparts[-1];
  209.     $modpname = join('/',@modparts);
  210. }
  211. else {
  212.     $nested = 0;
  213.     @modparts = ();
  214.     $modfname = $modpname = $module;
  215. }
  216.  
  217.  
  218. if ($opt_O) {
  219.     warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname;
  220. } else {
  221.     die "Won't overwrite existing $ext$modpname\n" if -e $modpname;
  222. }
  223. if( $nested ){
  224.     $modpath = "";
  225.     foreach (@modparts){
  226.         mkdir("$modpath$_", 0777);
  227.         $modpath .= "$_/";
  228.     }
  229. }
  230. mkdir($modpname, 0777);
  231. chdir($modpname) || die "Can't chdir $ext$modpname: $!\n";
  232.  
  233. if( ! $opt_X ){  # use XS, unless it was disabled
  234.   open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n";
  235. }
  236. open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n";
  237.  
  238. $" = "\n\t";
  239. warn "Writing $ext$modpname/$modfname.pm\n";
  240.  
  241. print PM <<"END";
  242. package $module;
  243.  
  244. use strict;
  245. END
  246.  
  247. if( $opt_X || $opt_c || $opt_A ){
  248.     # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD
  249.     print PM <<'END';
  250. use vars qw($VERSION @ISA @EXPORT);
  251. END
  252. }
  253. else{
  254.     # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and
  255.     # will want Carp.
  256.     print PM <<'END';
  257. use Carp;
  258. use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
  259. END
  260. }
  261.  
  262. print PM <<'END';
  263.  
  264. require Exporter;
  265. END
  266.  
  267. print PM <<"END" if ! $opt_X;  # use DynaLoader, unless XS was disabled
  268. require DynaLoader;
  269. END
  270.  
  271. # require autoloader if XS is disabled.
  272. # if XS is enabled, require autoloader unless autoloading is disabled.
  273. if( $opt_X || (! $opt_A) ){
  274.     print PM <<"END";
  275. require AutoLoader;
  276. END
  277. }
  278.  
  279. if( $opt_X || ($opt_c && ! $opt_A) ){
  280.     # we won't have our own AUTOLOAD(), so we'll inherit it.
  281.     if( ! $opt_X ) { # use DynaLoader, unless XS was disabled
  282.         print PM <<"END";
  283.  
  284. \@ISA = qw(Exporter AutoLoader DynaLoader);
  285. END
  286.     }
  287.     else{
  288.         print PM <<"END";
  289.  
  290. \@ISA = qw(Exporter AutoLoader);
  291. END
  292.     }
  293. }
  294. else{
  295.     # 1) we have our own AUTOLOAD(), so don't need to inherit it.
  296.     # or
  297.     # 2) we don't want autoloading mentioned.
  298.     if( ! $opt_X ){ # use DynaLoader, unless XS was disabled
  299.         print PM <<"END";
  300.  
  301. \@ISA = qw(Exporter DynaLoader);
  302. END
  303.     }
  304.     else{
  305.         print PM <<"END";
  306.  
  307. \@ISA = qw(Exporter);
  308. END
  309.     }
  310. }
  311.  
  312. print PM<<"END";
  313. # Items to export into callers namespace by default. Note: do not export
  314. # names by default without a very good reason. Use EXPORT_OK instead.
  315. # Do not simply export all your public functions/methods/constants.
  316. \@EXPORT = qw(
  317.     @const_names
  318. );
  319. \$VERSION = '$TEMPLATE_VERSION';
  320.  
  321. END
  322.  
  323. print PM <<"END" unless $opt_c or $opt_X;
  324. sub AUTOLOAD {
  325.     # This AUTOLOAD is used to 'autoload' constants from the constant()
  326.     # XS function.  If a constant is not found then control is passed
  327.     # to the AUTOLOAD in AutoLoader.
  328.  
  329.     my \$constname;
  330.     (\$constname = \$AUTOLOAD) =~ s/.*:://;
  331.     my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
  332.     if (\$! != 0) {
  333.     if (\$! =~ /Invalid/) {
  334.         \$AutoLoader::AUTOLOAD = \$AUTOLOAD;
  335.         goto &AutoLoader::AUTOLOAD;
  336.     }
  337.     else {
  338.         croak "Your vendor has not defined $module macro \$constname";
  339.     }
  340.     }
  341.     eval "sub \$AUTOLOAD { \$val }";
  342.     goto &\$AUTOLOAD;
  343. }
  344.  
  345. END
  346.  
  347. if( ! $opt_X ){ # print bootstrap, unless XS is d