Re: perl@10611
Nicholas Clark [Sat, 16 Jun 2001 16:52:47 +0000 (17:52 +0100)]
Message-ID: <20010616165247.O98663@plum.flirble.org>

p4raw-id: //depot/perl@10631

ext/GDBM_File/Makefile.PL
ext/POSIX/Makefile.PL
ext/Socket/Makefile.PL
ext/Sys/Syslog/Makefile.PL
lib/ExtUtils/Constant.pm

index 2a7256f..f9dd2d2 100644 (file)
@@ -1,8 +1,18 @@
 use ExtUtils::MakeMaker;
+use ExtUtils::Constant 0.07 'WriteConstants';
 WriteMakefile(
     NAME => 'GDBM_File',
     LIBS => ["-L/usr/local/lib -lgdbm", "-ldbm"],
     MAN3PODS   => {},  # Pods will be built by installman.
     XSPROTOARG => '-noprototypes',             # XXX remove later?
     VERSION_FROM => 'GDBM_File.pm',
+    realclean => {FILES=> 'constants.c constants.xs'},
+);
+WriteConstants(
+    NAME => 'GDBM_File',
+    DEFAULT_TYPE => 'IV',
+    BREAKOUT_AT => 8,
+    NAMES => [qw(GDBM_CACHESIZE GDBM_FAST GDBM_FASTMODE GDBM_INSERT GDBM_NEWDB
+                 GDBM_NOLOCK GDBM_READER GDBM_REPLACE GDBM_WRCREAT
+                 GDBM_WRITER)],
 );
index 73bb02d..0d14224 100644 (file)
@@ -1,4 +1,5 @@
 use ExtUtils::MakeMaker;
+use ExtUtils::Constant 0.07 'WriteConstants';
 use Config;
 my @libs;
 if ($^O ne 'MSWin32') {
@@ -11,3 +12,89 @@ WriteMakefile(
     XSPROTOARG => '-noprototypes',             # XXX remove later?
     VERSION_FROM => 'POSIX.pm', 
 );
+
+my @names =
+  (
+   qw(ARG_MAX B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400 B300 B38400 B4800
+      B50 B600 B75 B9600 BRKINT BUFSIZ CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX
+      CLK_TCK CLOCAL CLOCKS_PER_SEC CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB E2BIG
+      EACCES EADDRINUSE EADDRNOTAVAIL EAFNOSUPPORT EAGAIN EALREADY EBADF
+      EBUSY ECHILD ECHO ECHOE ECHOK ECHONL ECONNABORTED ECONNREFUSED
+      ECONNRESET EDEADLK EDESTADDRREQ EDOM EDQUOT EEXIST EFAULT EFBIG
+      EHOSTDOWN EHOSTUNREACH EINPROGRESS EINTR EINVAL EIO EISCONN EISDIR
+      ELOOP EMFILE EMLINK EMSGSIZE ENAMETOOLONG ENETDOWN ENETRESET
+      ENETUNREACH ENFILE ENOBUFS ENODEV ENOENT ENOEXEC ENOLCK ENOMEM
+      ENOPROTOOPT ENOSPC ENOSYS ENOTBLK ENOTCONN ENOTDIR ENOTEMPTY ENOTSOCK
+      ENOTTY ENXIO EOF EOPNOTSUPP EPERM EPFNOSUPPORT EPIPE EPROCLIM
+      EPROTONOSUPPORT EPROTOTYPE ERANGE EREMOTE ERESTART EROFS ESHUTDOWN
+      ESOCKTNOSUPPORT ESPIPE ESRCH ESTALE ETIMEDOUT ETOOMANYREFS ETXTBSY
+      EUSERS EWOULDBLOCK EXDEV FD_CLOEXEC FILENAME_MAX F_DUPFD F_GETFD
+      F_GETFL F_GETLK F_OK F_RDLCK F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK
+      F_WRLCK HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR INLCR INPCK
+      INT_MAX INT_MIN ISIG ISTRIP IXOFF IXON LC_ALL LC_COLLATE LC_CTYPE
+      LC_MESSAGES LC_MONETARY LC_NUMERIC LC_TIME LINK_MAX LONG_MAX LONG_MIN
+      L_ctermid L_cuserid L_tmpnam MAX_CANON MAX_INPUT MB_CUR_MAX MB_LEN_MAX
+      NAME_MAX NCCS NGROUPS_MAX NOFLSH OPEN_MAX OPOST O_ACCMODE O_APPEND
+      O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC O_WRONLY
+      PARENB PARMRK PARODD PATH_MAX PIPE_BUF RAND_MAX R_OK SCHAR_MAX
+      SCHAR_MIN SEEK_CUR SEEK_END SEEK_SET SHRT_MAX SHRT_MIN SIGABRT SIGALRM
+      SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT
+      SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2
+      SIG_BLOCK SIG_SETMASK SIG_UNBLOCK SSIZE_MAX STDERR_FILENO STDIN_FILENO
+      STDOUT_FILENO STREAM_MAX S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO
+      S_IRWXU S_ISGID S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH
+      S_IXUSR TCIFLUSH TCIOFF TCIOFLUSH TCION TCOFLUSH TCOOFF TCOON
+      TCSADRAIN TCSAFLUSH TCSANOW TMP_MAX TOSTOP TZNAME_MAX VEOF VEOL VERASE
+      VINTR VKILL VMIN VQUIT VSTART VSTOP VSUSP VTIME WNOHANG WUNTRACED W_OK
+      X_OK _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON _PC_MAX_INPUT
+      _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX _PC_PIPE_BUF _PC_VDISABLE
+      _SC_ARG_MAX _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL _SC_NGROUPS_MAX
+      _SC_OPEN_MAX _SC_SAVED_IDS _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION),
+   {name=>"EXIT_FAILURE", default=>["IV", "1"]},
+   {name=>"EXIT_SUCCESS", default=>["IV", "0"]},
+   {name=>"SIG_DFL", value=>"(IV)SIG_DFL"},
+   {name=>"SIG_ERR", value=>"(IV)SIG_ERR"},
+   {name=>"SIG_IGN", value=>"(IV)SIG_IGN"},
+   # L_tmpnam[e] was a typo--retained for compatibility
+   {name=>"L_tmpname", value=>"L_tmpnam"},
+   {name=>"NULL", value=>"0"},
+   {name=>"_POSIX_JOB_CONTROL", type=>"YES", default=>["IV", "0"]},
+   {name=>"_POSIX_SAVED_IDS", type=>"YES", default=>["IV", "0"]},
+   {name=>"HUGE_VAL", type=>"NV",
+    macro=>[<<'END', "#endif\n"],
+#if (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)) || defined(HUGE_VAL)
+       /* HUGE_VALL is admittedly non-POSIX but if we are using long doubles
+        * we might as well use long doubles. --jhi */
+END
+    value=>'
+#if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
+                   HUGE_VALL
+#else
+                   HUGE_VAL
+#endif
+                           '});
+
+push @names, {name=>$_, type=>"UV"}
+  foreach (qw(SA_NOCLDSTOP SA_NOCLDWAIT SA_NODEFER SA_ONSTACK SA_RESETHAND
+             SA_RESTART SA_SIGINFO UCHAR_MAX UINT_MAX ULONG_MAX USHRT_MAX));
+push @names, {name=>$_, type=>"NV"}
+  foreach (qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG DBL_MAX DBL_MAX_10_EXP
+              DBL_MAX_EXP DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP
+              FLT_DIG FLT_EPSILON FLT_MANT_DIG FLT_MAX FLT_MAX_10_EXP
+              FLT_MAX_EXP FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP FLT_RADIX
+              FLT_ROUNDS
+              LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG LDBL_MAX LDBL_MAX_10_EXP
+              LDBL_MAX_EXP LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP));
+
+push @names, {name=>$_, type=>"IV", default=>["IV", "0"]}
+  foreach (qw(_POSIX_ARG_MAX _POSIX_CHILD_MAX _POSIX_CHOWN_RESTRICTED
+              _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT _POSIX_NAME_MAX
+              _POSIX_NGROUPS_MAX _POSIX_NO_TRUNC _POSIX_OPEN_MAX
+              _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX
+              _POSIX_STREAM_MAX _POSIX_TZNAME_MAX _POSIX_VDISABLE _POSIX_VERSION
+             ));
+
+WriteConstants(
+    NAME => 'POSIX',
+    NAMES => \@names,
+);
index 339c45a..3c13ad9 100644 (file)
@@ -1,4 +1,5 @@
 use ExtUtils::MakeMaker;
+use ExtUtils::Constant 0.07 'WriteConstants';
 use Config;
 WriteMakefile(
     NAME        => 'Socket',
@@ -7,3 +8,42 @@ WriteMakefile(
     MAN3PODS    => {},         # Pods will be built by installman.
     XSPROTOARG   => '-noprototypes',           # XXX remove later?
 );
+my @names = (qw(AF_802 AF_APPLETALK AF_CCITT AF_CHAOS AF_DATAKIT AF_DECnet
+              AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK AF_INET AF_LAT
+              AF_MAX AF_NBS AF_NIT AF_NS AF_OSI AF_OSINET AF_PUP AF_SNA
+              AF_UNIX AF_UNSPEC AF_X25 IOV_MAX IPPROTO_TCP MSG_BCAST
+              MSG_CTLFLAGS MSG_CTLIGNORE MSG_DONTWAIT MSG_EOF MSG_EOR
+              MSG_ERRQUEUE MSG_FIN MSG_MAXIOVLEN MSG_MCAST MSG_NOSIGNAL
+              MSG_RST MSG_SYN MSG_TRUNC MSG_WAITALL PF_802 PF_APPLETALK
+              PF_CCITT PF_CHAOS PF_DATAKIT PF_DECnet PF_DLI PF_ECMA PF_GOSIP
+              PF_HYLINK PF_IMPLINK PF_INET PF_LAT PF_MAX PF_NBS PF_NIT PF_NS
+              PF_OSI PF_OSINET PF_PUP PF_SNA PF_UNIX PF_UNSPEC PF_X25
+              SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_TIMESTAMP SOCK_DGRAM
+              SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM SOL_SOCKET
+              SOMAXCONN SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTLINGER
+              SO_DONTROUTE SO_ERROR SO_KEEPALIVE SO_LINGER SO_OOBINLINE
+              SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
+              SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_TYPE SO_USELOOPBACK
+              TCP_KEEPALIVE TCP_MAXRT TCP_MAXSEG TCP_NODELAY TCP_STDURG
+              UIO_MAXIOV MSG_URG),
+            {name=>"SHUT_RD", type=>"IV", default=>["IV", "0"]},
+            {name=>"SHUT_WR", type=>"IV", default=>["IV", "1"]},
+            {name=>"SHUT_RDWR", type=>"IV", default=>["IV", "2"]},
+);
+
+push @names,
+  {name=>$_, type=>"IV",
+   macro=>["#if defined($_) || defined(HAS_$_) /* might be an enum */\n",
+           "#endif\n"]}
+foreach qw (MSG_CTRUNC MSG_DONTROUTE MSG_OOB MSG_PEEK MSG_PROXY SCM_RIGHTS);
+
+push @names, 
+{name => $_, type => "SV",
+ pre=>"struct in_addr ip_address; ip_address.s_addr = htonl($_);",
+ value => "sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ))",}
+         foreach qw(INADDR_ANY INADDR_LOOPBACK INADDR_NONE INADDR_BROADCAST);
+
+WriteConstants(
+    NAME => 'Socket',
+    NAMES => \@names,
+);
index e5edf3e..5824dfb 100644 (file)
@@ -1,4 +1,5 @@
 use ExtUtils::MakeMaker;
+use ExtUtils::Constant 0.07 'WriteConstants';
 
 WriteMakefile(
     NAME               => 'Sys::Syslog',
@@ -6,3 +7,15 @@ WriteMakefile(
     MAN3PODS           => {},  # Pods will be built by installman.
     XSPROTOARG          => '-noprototypes',
 );
+WriteConstants(
+    NAME => 'GDBM_File',
+    NAMES => [qw(LOG_ALERT LOG_AUTH LOG_AUTHPRIV LOG_CONS LOG_CRIT LOG_CRON
+                 LOG_DAEMON LOG_DEBUG LOG_EMERG LOG_ERR LOG_FACMASK LOG_FTP
+                 LOG_INFO LOG_KERN LOG_LFMT LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2
+                 LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR
+                 LOG_MAIL LOG_NDELAY LOG_NEWS LOG_NFACILITIES LOG_NOTICE
+                 LOG_NOWAIT LOG_ODELAY LOG_PERROR LOG_PID LOG_PRIMASK LOG_SYSLOG
+                 LOG_USER LOG_UUCP LOG_WARNING),
+              {name=>"_PATH_LOG", type=>"PV", default=>["PV", '""']},
+             ],
+);
index 60457eb..7bb3a64 100644 (file)
@@ -1,6 +1,6 @@
 package ExtUtils::Constant;
 use vars qw (@ISA $VERSION %XS_Constant %XS_TypeSet @EXPORT_OK %EXPORT_TAGS);
-$VERSION = '0.06';
+$VERSION = '0.07';
 
 =head1 NAME
 
@@ -8,14 +8,15 @@ ExtUtils::Constant - generate XS code to import C header constants
 
 =head1 SYNOPSIS
 
-    use ExtUtils::Constant qw (constant_types C_constant XS_constant);
-    print constant_types(); # macro defs
-    foreach (C_constant ("Foo", undef, "IV", undef, undef, undef,
-                         @names) ) {
-       print $_, "\n"; # C constant subs
-    }
-    print "MODULE = Foo                PACKAGE = Foo\n";
-    print XS_constant ("Foo", {NV => 1, IV => 1}); # XS for Foo::constant
+    use ExtUtils::Constant qw (WriteConstants);
+    WriteConstants(
+        NAME => 'Foo',
+        NAMES => [qw(FOO BAR BAZ)],
+        C_FILE => 'constants.c',
+        XS_FILE => 'constants.xs',
+    );
+    # Generates wrapper code to make the values of the constants FOO BAR BAZ
+    #  available to perl
 
 =head1 DESCRIPTION
 
@@ -27,8 +28,18 @@ constants.
 
 =head1 USAGE
 
-Generally one only needs to call the 3 functions shown in the synopsis,
-C<constant_types()>, C<C_constant> and C<XS_constant>.
+Generally one only needs to call the C<WriteConstants> function, and then
+
+    #include "constants.c"
+
+in the C section of C<Foo.xs>
+
+    INCLUDE constants.xs
+
+in the XS section of C<Foo.xs>.
+
+For greater flexibility use C<constant_types()>, C<C_constant> and
+C<XS_constant>, with which C<WriteConstants> is implemented.
 
 Currently this module understands the following types. h2xs may only know
 a subset. The sizes of the numeric types are chosen by the C<Configure>
@@ -95,7 +106,7 @@ $Text::Wrap::columns = 80;
 
 %EXPORT_TAGS = ( 'all' => [ qw(
        XS_constant constant_types return_clause memEQ_clause C_stringify
-       C_constant autoload
+       C_constant autoload WriteConstants
 ) ] );
 
 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
@@ -417,8 +428,8 @@ sub switch_clause {
 
 An internal function. I<WHAT> should be a hashref of types the constant
 function will return. I<params> returns the list of flags C<$use_iv, $use_nv,
-$use_pv> to show which combination of pointers will be needed in the C
-argument list.
+$use_pv, $use_sv> to show which combination of pointers will be needed in the
+C argument list.
 
 =cut
 
@@ -956,6 +967,98 @@ END
 
   return $func;
 }
+
+
+=item WriteConstants ATTRIBUTE =E<gt> VALUE [, ...]
+
+Writes a file of C code and a file of XS code which you should C<#include>
+and C<INCLUDE> in the C and XS sections respectively of your module's XS
+code.  You probaby want to do this in your C<Makefile.PL>, so that you can
+easily edit the list of constants without touching the rest of your module.
+The attributes supported are
+
+=over 4
+
+=item NAME
+
+Name of the module.  This must be specified
+
+=item DEFAULT_TYPE
+
+The default type for the constants.  If not specified C<IV> is assumed.
+
+=item BREAKOUT_AT
+
+The names of the constants are grouped by length.  Generate child subroutines
+for each group with this number or more names in.
+
+=item NAMES
+
+An array of constants' names, either scalars containing names, or hashrefs
+as detailed in L<"C_constant">.
+
+=item C_FILE
+
+The name of the file to write containing the C code.  The default is
+C<constants.c>.
+
+=item XS_FILE
+
+The name of the file to write containing the XS code.  The default is
+C<constants.xs>.
+
+=item SUBNAME
+
+The perl visible name of the XS subroutine generated which will return the
+constants. The default is C<constant>.  
+
+=item C_SUBNAME
+
+The name of the C subroutine generated which will return the constants.
+The default is I<SUBNAME>.  Child subroutines have C<_> and the name
+length appended, so constants with 10 character names would be in
+C<constant_10> with the default I<XS_SUBNAME>.
+
+=back
+
+=cut
+
+sub WriteConstants {
+  my %ARGS =
+    ( # defaults
+     C_FILE =>       'constants.c',
+     XS_FILE =>      'constants.xs',
+     SUBNAME =>      'constant',
+     DEFAULT_TYPE => 'IV',
+     @_);
+
+  $ARGS{C_SUBNAME} ||= $ARGS{SUBNAME}; # No-one sane will have C_SUBNAME eq '0'
+
+  croak "Module name not specified" unless length $ARGS{NAME};
+
+  open my $c_fh, ">$ARGS{C_FILE}" or die "Can't open $ARGS{C_FILE}: $!";
+  open my $xs_fh, ">$ARGS{XS_FILE}" or die "Can't open $ARGS{XS_FILE}: $!";
+
+  # As this subroutine is intended to make code that isn't edited, there's no
+  # need for the user to specify any types that aren't found in the list of
+  # names.
+  my $types = {};
+
+  print $c_fh constant_types(); # macro defs
+  print $c_fh "\n";
+
+  # indent is still undef. Until anyone implents indent style rules with it.
+  foreach (C_constant ($ARGS{NAME}, $ARGS{C_SUBNAME}, $ARGS{DEFAULT_TYPE},
+                       $types, undef, $ARGS{BREAKOUT_AT}, @{$ARGS{NAMES}})) {
+    print $c_fh $_, "\n"; # C constant subs
+  }
+  print $xs_fh XS_constant ($ARGS{NAME}, $types, $ARGS{XS_SUBNAME},
+                            $ARGS{C_SUBNAME});
+
+  close $c_fh or warn "Error closing $ARGS{C_FILE}: $!";
+  close $xs_fh or warn "Error closing $ARGS{XS_FILE}: $!";
+}
+
 1;
 __END__