From: Nicholas Clark Date: Sat, 16 Jun 2001 16:52:47 +0000 (+0100) Subject: Re: perl@10611 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0552bf3aa35a09dc25e478c87373918f99839617;p=p5sagit%2Fp5-mst-13.2.git Re: perl@10611 Message-ID: <20010616165247.O98663@plum.flirble.org> p4raw-id: //depot/perl@10631 --- diff --git a/ext/GDBM_File/Makefile.PL b/ext/GDBM_File/Makefile.PL index 2a7256f..f9dd2d2 100644 --- a/ext/GDBM_File/Makefile.PL +++ b/ext/GDBM_File/Makefile.PL @@ -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)], ); diff --git a/ext/POSIX/Makefile.PL b/ext/POSIX/Makefile.PL index 73bb02d..0d14224 100644 --- a/ext/POSIX/Makefile.PL +++ b/ext/POSIX/Makefile.PL @@ -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, +); diff --git a/ext/Socket/Makefile.PL b/ext/Socket/Makefile.PL index 339c45a..3c13ad9 100644 --- a/ext/Socket/Makefile.PL +++ b/ext/Socket/Makefile.PL @@ -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, +); diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL index e5edf3e..5824dfb 100644 --- a/ext/Sys/Syslog/Makefile.PL +++ b/ext/Sys/Syslog/Makefile.PL @@ -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", '""']}, + ], +); diff --git a/lib/ExtUtils/Constant.pm b/lib/ExtUtils/Constant.pm index 60457eb..7bb3a64 100644 --- a/lib/ExtUtils/Constant.pm +++ b/lib/ExtUtils/Constant.pm @@ -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, C and C. +Generally one only needs to call the C function, and then + + #include "constants.c" + +in the C section of C + + INCLUDE constants.xs + +in the XS section of C. + +For greater flexibility use C, C and +C, with which C 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 @@ -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 should be a hashref of types the constant function will return. I 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 VALUE [, ...] + +Writes a file of C code and a file of XS code which you should C<#include> +and C in the C and XS sections respectively of your module's XS +code. You probaby want to do this in your C, 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 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. + +=item XS_FILE + +The name of the file to write containing the XS code. The default is +C. + +=item SUBNAME + +The perl visible name of the XS subroutine generated which will return the +constants. The default is C. + +=item C_SUBNAME + +The name of the C subroutine generated which will return the constants. +The default is I. Child subroutines have C<_> and the name +length appended, so constants with 10 character names would be in +C with the default I. + +=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__