From: Nicholas Clark Date: Thu, 14 Jun 2001 23:52:56 +0000 (+0100) Subject: INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cea00dc580b73966c5c98fc99732fe610def4247;p=p5sagit%2Fp5-mst-13.2.git INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE Message-ID: <20010614235256.G98663@plum.flirble.org> p4raw-id: //depot/perl@10601 --- diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm index 2b2c03e..06d8c74 100644 --- a/ext/Socket/Socket.pm +++ b/ext/Socket/Socket.pm @@ -1,7 +1,7 @@ package Socket; our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = "1.73"; +$VERSION = "1.74"; =head1 NAME @@ -334,7 +334,7 @@ sub AUTOLOAD { if ($error) { croak $error; } - eval "sub $AUTOLOAD () { $val }"; + *$AUTOLOAD = sub { $val }; goto &$AUTOLOAD; } diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs index 30dd0f2..3bc472b 100644 --- a/ext/Socket/Socket.xs +++ b/ext/Socket/Socket.xs @@ -177,52 +177,17 @@ not_here(char *s) #define PERL_constant_NOTFOUND 1 #define PERL_constant_NOTDEF 2 #define PERL_constant_ISIV 3 -#define PERL_constant_ISNV 4 -#define PERL_constant_ISPV 5 -#define PERL_constant_ISPVN 6 -#define PERL_constant_ISUV 7 - -#ifndef NVTYPE -typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ -#endif - -static int -constant_5 (const char *name, IV *iv_return) { - /* Names all of length 5. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - AF_NS PF_NS */ - /* Offset 0 gives the best switch position. */ - switch (name[0]) { - case 'A': - if (memEQ(name, "AF_NS", 5)) { - /* ^ */ -#ifdef AF_NS - *iv_return = AF_NS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "PF_NS", 5)) { - /* ^ */ -#ifdef PF_NS - *iv_return = PF_NS; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} +#define PERL_constant_ISNO 4 +#define PERL_constant_ISNV 5 +#define PERL_constant_ISPV 6 +#define PERL_constant_ISPVN 7 +#define PERL_constant_ISSV 8 +#define PERL_constant_ISUNDEF 9 +#define PERL_constant_ISUV 10 +#define PERL_constant_ISYES 11 static int -constant_6 (const char *name, IV *iv_return) { - /* Names all of length 6. */ +constant_6 (const char *name, IV *iv_return, SV **sv_return) { /* When generated this function returned values for the list of names given here. However, subsequent manual editing may have added or removed some. AF_802 AF_DLI AF_LAT AF_MAX AF_NBS AF_NIT AF_OSI AF_PUP AF_SNA AF_X25 @@ -432,8 +397,7 @@ constant_6 (const char *name, IV *iv_return) { } static int -constant_7 (const char *name, IV *iv_return) { - /* Names all of length 7. */ +constant_7 (const char *name, IV *iv_return, SV **sv_return) { /* When generated this function returned values for the list of names given here. However, subsequent manual editing may have added or removed some. AF_ECMA AF_INET AF_UNIX IOV_MAX MSG_EOF MSG_EOR MSG_FIN MSG_OOB MSG_RST @@ -542,7 +506,7 @@ constant_7 (const char *name, IV *iv_return) { break; case 'O': if (memEQ(name, "MSG_OOB", 7)) { - /* ^ */ + /* ^ */ #if defined(MSG_OOB) || defined(HAS_MSG_OOB) /* might be an enum */ *iv_return = MSG_OOB; return PERL_constant_ISIV; @@ -622,8 +586,7 @@ constant_7 (const char *name, IV *iv_return) { } static int -constant_8 (const char *name, IV *iv_return) { - /* Names all of length 8. */ +constant_8 (const char *name, IV *iv_return, SV **sv_return) { /* When generated this function returned values for the list of names given here. However, subsequent manual editing may have added or removed some. AF_CCITT AF_CHAOS AF_GOSIP MSG_PEEK PF_CCITT PF_CHAOS PF_GOSIP SOCK_RAW @@ -750,8 +713,7 @@ constant_8 (const char *name, IV *iv_return) { } static int -constant_9 (const char *name, IV *iv_return) { - /* Names all of length 9. */ +constant_9 (const char *name, IV *iv_return, SV **sv_return) { /* When generated this function returned values for the list of names given here. However, subsequent manual editing may have added or removed some. AF_DECnet AF_HYLINK AF_OSINET AF_UNSPEC MSG_BCAST MSG_MCAST MSG_PROXY @@ -960,12 +922,11 @@ constant_9 (const char *name, IV *iv_return) { } static int -constant_10 (const char *name, IV *iv_return) { - /* Names all of length 10. */ +constant_10 (const char *name, IV *iv_return, SV **sv_return) { /* When generated this function returned values for the list of names given here. However, subsequent manual editing may have added or removed some. - AF_DATAKIT AF_IMPLINK MSG_CTRUNC PF_DATAKIT PF_IMPLINK SCM_RIGHTS - SOCK_DGRAM SOL_SOCKET TCP_MAXSEG TCP_STDURG UIO_MAXIOV */ + AF_DATAKIT AF_IMPLINK INADDR_ANY MSG_CTRUNC PF_DATAKIT PF_IMPLINK + SCM_RIGHTS SOCK_DGRAM SOL_SOCKET TCP_MAXSEG TCP_STDURG UIO_MAXIOV */ /* Offset 6 gives the best switch position. */ switch (name[6]) { case 'A': @@ -1081,42 +1042,55 @@ constant_10 (const char *name, IV *iv_return) { #endif } break; + case '_': + if (memEQ(name, "INADDR_ANY", 10)) { + /* ^ */ +#ifdef INADDR_ANY + { +struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_ANY); + *sv_return = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address )); + return PERL_constant_ISSV; + } +#else + return PERL_constant_NOTDEF; +#endif + } + break; } return PERL_constant_NOTFOUND; } static int -constant_11 (const char *name, IV *iv_return) { - /* Names all of length 11. */ +constant_11 (const char *name, IV *iv_return, SV **sv_return) { /* When generated this function returned values for the list of names given here. However, subsequent manual editing may have added or removed some. - IPPROTO_TCP MSG_WAITALL SCM_CONNECT SOCK_STREAM SO_RCVLOWAT SO_RCVTIMEO - SO_SNDLOWAT SO_SNDTIMEO TCP_NODELAY */ - /* Offset 7 gives the best switch position. */ - switch (name[7]) { - case 'E': - if (memEQ(name, "TCP_NODELAY", 11)) { - /* ^ */ -#ifdef TCP_NODELAY - *iv_return = TCP_NODELAY; + INADDR_NONE IPPROTO_TCP MSG_WAITALL SCM_CONNECT SOCK_STREAM SO_RCVLOWAT + SO_RCVTIMEO SO_SNDLOWAT SO_SNDTIMEO TCP_NODELAY */ + /* Offset 5 gives the best switch position. */ + switch (name[5]) { + case 'A': + if (memEQ(name, "MSG_WAITALL", 11)) { + /* ^ */ +#ifdef MSG_WAITALL + *iv_return = MSG_WAITALL; return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; #endif } break; - case 'I': - if (memEQ(name, "SO_RCVTIMEO", 11)) { - /* ^ */ -#ifdef SO_RCVTIMEO - *iv_return = SO_RCVTIMEO; + case 'D': + if (memEQ(name, "SO_SNDLOWAT", 11)) { + /* ^ */ +#ifdef SO_SNDLOWAT + *iv_return = SO_SNDLOWAT; return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; #endif } if (memEQ(name, "SO_SNDTIMEO", 11)) { - /* ^ */ + /* ^ */ #ifdef SO_SNDTIMEO *iv_return = SO_SNDTIMEO; return PERL_constant_ISIV; @@ -1125,9 +1099,9 @@ constant_11 (const char *name, IV *iv_return) { #endif } break; - case 'N': + case 'O': if (memEQ(name, "SCM_CONNECT", 11)) { - /* ^ */ + /* ^ */ #ifdef SCM_CONNECT *iv_return = SCM_CONNECT; return PERL_constant_ISIV; @@ -1135,30 +1109,33 @@ constant_11 (const char *name, IV *iv_return) { return PERL_constant_NOTDEF; #endif } - break; - case 'O': - if (memEQ(name, "SO_RCVLOWAT", 11)) { - /* ^ */ -#ifdef SO_RCVLOWAT - *iv_return = SO_RCVLOWAT; + if (memEQ(name, "TCP_NODELAY", 11)) { + /* ^ */ +#ifdef TCP_NODELAY + *iv_return = TCP_NODELAY; return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; #endif } - if (memEQ(name, "SO_SNDLOWAT", 11)) { - /* ^ */ -#ifdef SO_SNDLOWAT - *iv_return = SO_SNDLOWAT; - return PERL_constant_ISIV; + break; + case 'R': + if (memEQ(name, "INADDR_NONE", 11)) { + /* ^ */ +#ifdef INADDR_NONE + { +struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_NONE); + *sv_return = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address )); + return PERL_constant_ISSV; + } #else return PERL_constant_NOTDEF; #endif } break; - case 'R': + case 'S': if (memEQ(name, "SOCK_STREAM", 11)) { - /* ^ */ + /* ^ */ #ifdef SOCK_STREAM *iv_return = SOCK_STREAM; return PERL_constant_ISIV; @@ -1168,21 +1145,30 @@ constant_11 (const char *name, IV *iv_return) { } break; case 'T': - if (memEQ(name, "MSG_WAITALL", 11)) { - /* ^ */ -#ifdef MSG_WAITALL - *iv_return = MSG_WAITALL; + if (memEQ(name, "IPPROTO_TCP", 11)) { + /* ^ */ +#ifdef IPPROTO_TCP + *iv_return = IPPROTO_TCP; return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; #endif } break; - case '_': - if (memEQ(name, "IPPROTO_TCP", 11)) { - /* ^ */ -#ifdef IPPROTO_TCP - *iv_return = IPPROTO_TCP; + case 'V': + if (memEQ(name, "SO_RCVLOWAT", 11)) { + /* ^ */ +#ifdef SO_RCVLOWAT + *iv_return = SO_RCVLOWAT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "SO_RCVTIMEO", 11)) { + /* ^ */ +#ifdef SO_RCVTIMEO + *iv_return = SO_RCVTIMEO; return PERL_constant_ISIV; #else return PERL_constant_NOTDEF; @@ -1194,8 +1180,7 @@ constant_11 (const char *name, IV *iv_return) { } static int -constant_12 (const char *name, IV *iv_return) { - /* Names all of length 12. */ +constant_12 (const char *name, IV *iv_return, SV **sv_return) { /* When generated this function returned values for the list of names given here. However, subsequent manual editing may have added or removed some. AF_APPLETALK MSG_CTLFLAGS MSG_DONTWAIT MSG_ERRQUEUE MSG_NOSIGNAL @@ -1338,8 +1323,7 @@ constant_12 (const char *name, IV *iv_return) { } static int -constant_13 (const char *name, IV *iv_return) { - /* Names all of length 13. */ +constant_13 (const char *name, IV *iv_return, SV **sv_return) { /* When generated this function returned values for the list of names given here. However, subsequent manual editing may have added or removed some. MSG_CTLIGNORE MSG_DONTROUTE MSG_MAXIOVLEN SCM_TIMESTAMP SO_ACCEPTCONN @@ -1428,41 +1412,7 @@ constant_13 (const char *name, IV *iv_return) { } static int -constant_14 (const char *name, IV *iv_return) { - /* Names all of length 14. */ - /* When generated this function returned values for the list of names given - here. However, subsequent manual editing may have added or removed some. - SOCK_SEQPACKET SO_USELOOPBACK */ - /* Offset 8 gives the best switch position. */ - switch (name[8]) { - case 'O': - if (memEQ(name, "SO_USELOOPBACK", 14)) { - /* ^ */ -#ifdef SO_USELOOPBACK - *iv_return = SO_USELOOPBACK; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - case 'P': - if (memEQ(name, "SOCK_SEQPACKET", 14)) { - /* ^ */ -#ifdef SOCK_SEQPACKET - *iv_return = SOCK_SEQPACKET; - return PERL_constant_ISIV; -#else - return PERL_constant_NOTDEF; -#endif - } - break; - } - return PERL_constant_NOTFOUND; -} - -static int -constant (const char *name, STRLEN len, IV *iv_return) { +constant (const char *name, STRLEN len, IV *iv_return, SV **sv_return) { /* Initially switch on the length of the name. */ /* When generated this function returned values for the list of names given in this section of perl code. Rather than manually editing these functions @@ -1474,28 +1424,32 @@ constant (const char *name, STRLEN len, IV *iv_return) { Regenerate these constant functions by feeding this entire source file to perl -x -#!perl -w +#!../../perl -w use ExtUtils::Constant qw (constant_types C_constant XS_constant); -my $types = {IV => 1}; +my $types = {map {($_, 1)} qw(IV SV)}; 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), + MSG_RST MSG_SYN MSG_TRUNC MSG_URG 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), + {name=>"INADDR_ANY", type=>"SV", value=>"sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ))", pre=>"struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_ANY);"}, + {name=>"INADDR_BROADCAST", type=>"SV", value=>"sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ))", pre=>"struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_BROADCAST);"}, + {name=>"INADDR_LOOPBACK", type=>"SV", value=>"sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ))", pre=>"struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_LOOPBACK);"}, + {name=>"INADDR_NONE", type=>"SV", value=>"sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address ))", pre=>"struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_NONE);"}, {name=>"MSG_CTRUNC", type=>"IV", macro=>["#if defined(MSG_CTRUNC) || defined(HAS_MSG_CTRUNC) /" . "* might be an enum *" . "/\n", "#endif\n"]}, {name=>"MSG_DONTROUTE", type=>"IV", macro=>["#if defined(MSG_DONTROUTE) || defined(HAS_MSG_DONTROUTE) /" . "* might be an enum *" . "/\n", "#endif\n"]}, {name=>"MSG_OOB", type=>"IV", macro=>["#if defined(MSG_OOB) || defined(HAS_MSG_OOB) /" . "* might be an enum *" . "/\n", "#endif\n"]}, @@ -1507,7 +1461,7 @@ my @names = (qw(AF_802 AF_APPLETALK AF_CCITT AF_CHAOS AF_DATAKIT AF_DECnet {name=>"SHUT_WR", type=>"IV", default=>["IV", "1"]}); print constant_types(); # macro defs -foreach (C_constant ("Socket", 'constant', 'IV', $types, undef, undef, @names) ) { +foreach (C_constant ("Socket", 'constant', 'IV', $types, undef, 3, @names) ) { print $_, "\n"; # C constant subs } print "#### XS Section:\n"; @@ -1517,40 +1471,127 @@ __END__ switch (len) { case 5: - return constant_5 (name, iv_return); + /* Names all of length 5. */ + /* AF_NS PF_NS */ + /* Offset 0 gives the best switch position. */ + switch (name[0]) { + case 'A': + if (memEQ(name, "AF_NS", 5)) { + /* ^ */ +#ifdef AF_NS + *iv_return = AF_NS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "PF_NS", 5)) { + /* ^ */ +#ifdef PF_NS + *iv_return = PF_NS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } break; case 6: - return constant_6 (name, iv_return); + return constant_6 (name, iv_return, sv_return); break; case 7: - return constant_7 (name, iv_return); + return constant_7 (name, iv_return, sv_return); break; case 8: - return constant_8 (name, iv_return); + return constant_8 (name, iv_return, sv_return); break; case 9: - return constant_9 (name, iv_return); + return constant_9 (name, iv_return, sv_return); break; case 10: - return constant_10 (name, iv_return); + return constant_10 (name, iv_return, sv_return); break; case 11: - return constant_11 (name, iv_return); + return constant_11 (name, iv_return, sv_return); break; case 12: - return constant_12 (name, iv_return); + return constant_12 (name, iv_return, sv_return); break; case 13: - return constant_13 (name, iv_return); + return constant_13 (name, iv_return, sv_return); break; case 14: - return constant_14 (name, iv_return); + /* Names all of length 14. */ + /* SOCK_SEQPACKET SO_USELOOPBACK */ + /* Offset 8 gives the best switch position. */ + switch (name[8]) { + case 'O': + if (memEQ(name, "SO_USELOOPBACK", 14)) { + /* ^ */ +#ifdef SO_USELOOPBACK + *iv_return = SO_USELOOPBACK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "SOCK_SEQPACKET", 14)) { + /* ^ */ +#ifdef SOCK_SEQPACKET + *iv_return = SOCK_SEQPACKET; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } break; case 15: - if (memEQ(name, "SCM_CREDENTIALS", 15)) { + /* Names all of length 15. */ + /* INADDR_LOOPBACK SCM_CREDENTIALS */ + /* Offset 4 gives the best switch position. */ + switch (name[4]) { + case 'C': + if (memEQ(name, "SCM_CREDENTIALS", 15)) { + /* ^ */ #ifdef SCM_CREDENTIALS - *iv_return = SCM_CREDENTIALS; - return PERL_constant_ISIV; + *iv_return = SCM_CREDENTIALS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'D': + if (memEQ(name, "INADDR_LOOPBACK", 15)) { + /* ^ */ +#ifdef INADDR_LOOPBACK + { +struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_LOOPBACK); + *sv_return = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address )); + return PERL_constant_ISSV; + } +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + break; + case 16: + if (memEQ(name, "INADDR_BROADCAST", 16)) { +#ifdef INADDR_BROADCAST + { +struct in_addr ip_address; ip_address.s_addr = htonl(INADDR_BROADCAST); + *sv_return = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address )); + return PERL_constant_ISSV; + } #else return PERL_constant_NOTDEF; #endif @@ -1566,11 +1607,7 @@ MODULE = Socket PACKAGE = Socket void constant(sv) PREINIT: -#ifdef dXSTARG - dXSTARG; /* Faster if we have it. */ -#else - dTARGET; -#endif + dXSTARG; STRLEN len; int type; IV iv; @@ -1582,7 +1619,7 @@ constant(sv) PPCODE: /* Change this to constant(s, len, &iv, &nv); if you need to return both NVs and IVs */ - type = constant(s, len, &iv); + type = constant(s, len, &iv, &sv); /* Return 1 or 2 items. First is error message, or undef if no error. Second, if present, is found value */ switch (type) { @@ -1600,6 +1637,11 @@ constant(sv) PUSHs(&PL_sv_undef); PUSHi(iv); break; + case PERL_constant_ISSV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(sv); + break; /* Uncomment this if you need to return UVs case PERL_constant_ISUV: EXTEND(SP, 1); @@ -1608,7 +1650,7 @@ constant(sv) break; */ default: sv = sv_2mortal(newSVpvf( - "Unexpected return type %d while processing Socket macro %s used", + "Unexpected return type %d while processing Socket macro %s, used", type, s)); PUSHs(sv); } @@ -1782,39 +1824,3 @@ unpack_sockaddr_in(sin_sv) PUSHs(sv_2mortal(newSViv((IV) port))); PUSHs(sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address))); } - -void -INADDR_ANY() - CODE: - { - struct in_addr ip_address; - ip_address.s_addr = htonl(INADDR_ANY); - ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address )); - } - -void -INADDR_LOOPBACK() - CODE: - { - struct in_addr ip_address; - ip_address.s_addr = htonl(INADDR_LOOPBACK); - ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)); - } - -void -INADDR_NONE() - CODE: - { - struct in_addr ip_address; - ip_address.s_addr = htonl(INADDR_NONE); - ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)); - } - -void -INADDR_BROADCAST() - CODE: - { - struct in_addr ip_address; - ip_address.s_addr = htonl(INADDR_BROADCAST); - ST(0) = sv_2mortal(newSVpvn((char *)&ip_address,sizeof ip_address)); - } diff --git a/lib/ExtUtils/Constant.pm b/lib/ExtUtils/Constant.pm index 41341c9..024d8cc 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.05'; +$VERSION = '0.06'; =head1 NAME @@ -57,6 +57,10 @@ NUL terminated string, length will be determined with C A fixed length thing, given as a [pointer, length] pair. If you know the length of a string at compile time you may use this instead of I +=item PVN + +A B SV. + =item YES Truth. (C) The value is not needed (and ignored). @@ -97,22 +101,24 @@ $Text::Wrap::columns = 80; @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); %XS_Constant = ( - IV => 'PUSHi(iv)', - UV => 'PUSHu((UV)iv)', - NV => 'PUSHn(nv)', - PV => 'PUSHp(pv, strlen(pv))', - PVN => 'PUSHp(pv, iv)', - YES => 'PUSHs(&PL_sv_yes)', - NO => 'PUSHs(&PL_sv_no)', + IV => 'PUSHi(iv)', + UV => 'PUSHu((UV)iv)', + NV => 'PUSHn(nv)', + PV => 'PUSHp(pv, strlen(pv))', + PVN => 'PUSHp(pv, iv)', + SV => 'PUSHs(sv)', + YES => 'PUSHs(&PL_sv_yes)', + NO => 'PUSHs(&PL_sv_no)', UNDEF => '', # implicit undef ); %XS_TypeSet = ( - IV => '*iv_return =', - UV => '*iv_return = (IV)', - NV => '*nv_return =', - PV => '*pv_return =', - PVN => ['*pv_return =', '*iv_return = (IV)'], + IV => '*iv_return =', + UV => '*iv_return = (IV)', + NV => '*nv_return =', + PV => '*pv_return =', + PVN => ['*pv_return =', '*iv_return = (IV)'], + SV => '*sv_return = ', YES => undef, NO => undef, UNDEF => undef, @@ -209,11 +215,13 @@ sub memEQ_clause { return $body; } -=item assign INDENT, TYPE, VALUE... +=item assign INDENT, TYPE, PRE, POST, VALUE... A function to return a suitable assignment clause. If I is aggregate (eg I expects both pointer and length) then there should be multiple -Is for the components. +Is for the components. I
 and I if defined give snippets
+of C code to preceed and follow the assignment. I
 will be at the start
+of a block, so variables may be defined in it.
 
 =cut
 
@@ -222,7 +230,18 @@ Is for the components.
 sub assign {
   my $indent = shift;
   my $type = shift;
+  my $pre = shift;
+  my $post = shift || '';
   my $clause;
+  my $close;
+  if ($pre) {
+    chomp $pre;
+    $clause = $indent . "{\n$pre";
+    $clause .= ";" unless $pre =~ /;$/;
+    $clause .= "\n";
+    $close = "$indent}\n";
+    $indent .= "  ";
+  }
   die "Can't generate code for type $type" unless exists $XS_TypeSet{$type};
   my $typeset = $XS_TypeSet{$type};
   if (ref $typeset) {
@@ -236,11 +255,18 @@ sub assign {
       if @_ > 1;
     $clause .= $indent . "$typeset $_[0];\n";
   }
+  chomp $post;
+  if (length $post) {
+    $clause .= "$post";
+    $clause .= ";" unless $post =~ /;$/;
+    $clause .= "\n";
+  }    
   $clause .= "${indent}return PERL_constant_IS$type;\n";
+  $clause .= $close if $close;
   return $clause;
 }
 
-=item return_clause VALUE, TYPE, INDENT, MACRO, DEFAULT
+=item return_clause VALUE, TYPE, INDENT, MACRO, DEFAULT, PRE, POST, PRE, POST
 
 A function to return a suitable C<#ifdef> clause. I defaults to
 I when not defined.  If I is aggregate (eg I expects both
@@ -249,17 +275,20 @@ values in the order expected by the type.  C will always call
 this function with I defined, defaulting to the constant's name.
 I if defined is an array reference giving default type and and
 value(s) if the clause generated by I doesn't evaluate to true.
+The two pairs I
 and I if defined give C code snippets to proceed
+and follow the value, and the default value.
 
 =cut
 
-sub return_clause ($$$$$) {
+sub return_clause ($$$$$$$$$) {
 ##ifdef thingy
 #      *iv_return = thingy;
 #      return PERL_constant_ISIV;
 ##else
 #      return PERL_constant_NOTDEF;
 ##endif
-  my ($value, $type, $indent, $macro, $default) = @_;
+  my ($value, $type, $indent, $macro, $default, $pre, $post,
+      $def_pre, $def_post) = @_;
   $macro = $value unless defined $macro;
   $indent = ' ' x ($indent || 6);
 
@@ -274,7 +303,8 @@ sub return_clause ($$$$$) {
 
   #      *iv_return = thingy;
   #      return PERL_constant_ISIV;
-  $clause .= assign ($indent, $type, ref $value ? @$value : $value);
+  $clause .= assign ($indent, $type, $pre, $post,
+                     ref $value ? @$value : $value);
 
   ##else
   $clause .= "#else\n";
@@ -283,7 +313,9 @@ sub return_clause ($$$$$) {
   if (!defined $default) {
     $clause .= "${indent}return PERL_constant_NOTDEF;\n";
   } else {
-    $clause .= assign ($indent, ref $default ? @$default : $default);
+    my @default = ref $default ? @$default : $default;
+    $type = shift @default;
+    $clause .= assign ($indent, $type, $def_pre, $def_post, @default);
   }
 
   ##endif
@@ -363,14 +395,16 @@ sub switch_clause {
     $body .= $indent . "case '" . C_stringify ($char) . "':\n";
     foreach my $name (sort @{$best->{$char}}) {
       my $thisone = $items->{$name};
-      my ($value, $macro, $default) = @$thisone{qw (value macro default)};
+      my ($value, $macro, $default, $pre, $post, $def_pre, $def_post)
+        = @$thisone{qw (value macro default pre post def_pre def_post)};
       $value = $name unless defined $value;
       $macro = $name unless defined $macro;
 
       # We have checked this offset.
       $body .= memEQ_clause ($name, $offset, 2 + length $indent);
       $body .= return_clause ($value, $thisone->{type},  4 + length $indent,
-                              $macro, $default);
+                              $macro, $default, $pre, $post,
+                              $def_pre, $def_post);
       $body .= $indent . "  }\n";
     }
     $body .= $indent . "  break;\n";
@@ -396,7 +430,8 @@ sub params {
   my $use_iv = $what->{IV} || $what->{UV} || $what->{PVN};
   my $use_nv = $what->{NV};
   my $use_pv = $what->{PV} || $what->{PVN};
-  return ($use_iv, $use_nv, $use_pv);
+  my $use_sv = $what->{SV};
+  return ($use_iv, $use_nv, $use_pv, $use_sv);
 }
 
 =item dump_names  
@@ -416,7 +451,9 @@ sub dump_names {
     my $type = $_->{type} || $default_type;
     if ($type eq $default_type and 0 == ($_->{name} =~ tr/A-Za-z0-9_//c)
         and !defined ($_->{macro}) and !defined ($_->{value})
-        and !defined ($_->{default})) {
+        and !defined ($_->{default}) and !defined ($_->{pre})
+        and !defined ($_->{post}) and !defined ($_->{def_pre})
+        and !defined ($_->{def_post})) {
       # It's the default type, and the name consists only of A-Za-z0-9_
       push @simple, $_->{name};
     } else {
@@ -445,32 +482,17 @@ EOT
   if (@complex) {
     foreach my $item (sort {$a->{name} cmp $b->{name}} @complex) {
       my $name = C_stringify $item->{name};
-      my ($macro, $value, $default) = @$item{qw (macro value default)};
       my $line = ",\n            {name=>\"$name\"";
       $line .= ", type=>\"$item->{type}\"" if defined $item->{type};
-      if (defined $macro) {
-        if (ref $macro) {
-          $line .= ', macro=>["'. join ('", "', map {C_stringify $_} @$macro)
-            . '"]';
-        } else {
-          $line .= ", macro=>\"" . C_stringify($macro) . "\"";
-        }
-      }
-      if (defined $value) {
-        if (ref $value) {
-          $line .= ', value=>["'. join ('", "', map {C_stringify $_} @$value)
-            . '"]';
-        } else {
-          $line .= ", value=>\"" . C_stringify($value) . "\"";
-        }
-      }
-      if (defined $default) {
-        if (ref $default) {
-          $line .= ', default=>["'. join ('", "', map {C_stringify $_}
-                                          @$default)
-            . '"]';
-        } else {
-          $line .= ", default=>\"" . C_stringify($default) . "\"";
+      foreach my $thing (qw (macro value default pre post def_pre def_post)) {
+        my $value = $item->{$thing};
+        if (defined $value) {
+          if (ref $value) {
+            $line .= ", $thing=>[\""
+              . join ('", "', map {C_stringify $_} @$value) . '"]';
+          } else {
+            $line .= ", $thing=>\"" . C_stringify($value) . "\"";
+          }
         }
       }
       $line .= "}";
@@ -561,6 +583,24 @@ Default value to use (instead of Cing with "your vendor has not
 defined...") to return if the macro isn't defined. Specify a reference to
 an array with type followed by value(s).
 
+=item pre
+
+C code to use before the assignment of the value of the constant. This allows
+you to use temporary variables to extract a value from part of a C
+and return this as I. This C code is places at the start of a block,
+so you can declare variables in it.
+
+=item post
+
+C code to place between the assignment of value (to a temporary) and the
+return from the function. This allows you to clear up anything in I
.
+Rarely needed.
+
+=item def_pre
+=item def_post
+
+Equivalents of I
 and I for the default value.
+
 =back
 
 I is the name of the package, and is only used in comments inside the
@@ -625,9 +665,10 @@ sub C_constant {
   foreach (@items) {
     my $name;
     if (ref $_) {
+      my $orig = $_;
       # Make a copy which is a normalised version of the ref passed in.
       $name = $_->{name};
-      my ($type, $macro, $value, $default) = @$_{qw (type macro value default)};
+      my ($type, $macro, $value) = @$_{qw (type macro value)};
       $type ||= $default_type;
       $what->{$type} = 1;
       $_ = {name=>$name, type=>$type};
@@ -636,7 +677,11 @@ sub C_constant {
       $_->{macro} = $macro if defined $macro;
       undef $value if defined $value and $value eq $name;
       $_->{value} = $value if defined $value;
-      $_->{default} = $default if defined $default;
+      foreach my $key (qw(default pre post def_pre def_post)) {
+        my $value = $orig->{$key};
+        $_->{$key} = $value if defined $value;
+        # warn "$key $value";
+      }
     } else {
       $name = $_;
       $_ = {name=>$_, type=>$default_type};
@@ -648,13 +693,14 @@ sub C_constant {
     }
     $items{$name} = $_;
   }
-  my ($use_iv, $use_nv, $use_pv) = params ($what);
+  my ($use_iv, $use_nv, $use_pv, $use_sv) = params ($what);
 
   my ($body, @subs) = "static int\n$subname (const char *name";
   $body .= ", STRLEN len" unless defined $namelen;
   $body .= ", IV *iv_return" if $use_iv;
   $body .= ", NV *nv_return" if $use_nv;
   $body .= ", const char **pv_return" if $use_pv;
+  $body .= ", SV **sv_return" if $use_sv;
   $body .= ") {\n";
 
   if (defined $namelen) {
@@ -679,14 +725,14 @@ sub C_constant {
       $body .= "  case $i:\n";
       if (@{$by_length[$i]} == 1) {
         my $thisone = $by_length[$i]->[0];
-        my ($name, $value, $macro, $default)
-          = @$thisone{qw (name value macro default)};
+        my ($name, $value, $macro, $default, $pre, $post, $def_pre, $def_post)
+          = @$thisone{qw (name value macro default pre post def_pre def_post)};
         $value = $name unless defined $value;
         $macro = $name unless defined $macro;
 
         $body .= memEQ_clause ($name);
         $body .= return_clause ($value, $thisone->{type}, undef, $macro,
-                                $default);
+                                $default, $pre, $post, $def_pre, $def_post);
         $body .= "    }\n";
       } elsif (@{$by_length[$i]} < $breakout) {
         $body .= switch_clause (4, '', $i, \%items, @{$by_length[$i]});
@@ -697,6 +743,7 @@ sub C_constant {
         $body .= ", iv_return" if $use_iv;
         $body .= ", nv_return" if $use_nv;
         $body .= ", pv_return" if $use_pv;
+        $body .= ", sv_return" if $use_sv;
         $body .= ");\n";
       }
       $body .= "    break;\n";
@@ -739,7 +786,7 @@ sub XS_constant {
     # Convert line of the form IV,UV,NV to hash
     $what = {map {$_ => 1} split /,\s*/, ($what)};
   }
-  my ($use_iv, $use_nv, $use_pv) = params ($what);
+  my ($use_iv, $use_nv, $use_pv, $use_sv) = params ($what);
   my $type;
 
   my $xs = <<"EOT";
@@ -789,6 +836,7 @@ EOT
   $xs .= ', &iv' if $use_iv;
   $xs .= ', &nv' if $use_nv;
   $xs .= ', &pv' if $use_pv;
+  $xs .= ', &sv' if $use_sv;
   $xs .= ");\n";
 
   $xs .= << "EOT";
diff --git a/t/lib/extutils.t b/t/lib/extutils.t
index fa256af..be03cb1 100644
--- a/t/lib/extutils.t
+++ b/t/lib/extutils.t
@@ -1,6 +1,6 @@
 #!./perl -w
 
-print "1..24\n";
+print "1..26\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -47,6 +47,9 @@ my %compass = (
 N => 0, NE => 45, E => 90, SE => 135, S => 180, SW => 225, W => 270, NW => 315
 );
 
+my $parent_rfc1149 =
+  'A Standard for the Transmission of IP Datagrams on Avian Carriers';
+
 my @names = ("FIVE", {name=>"OK6", type=>"PV",},
              {name=>"OK7", type=>"PVN",
               value=>['"not ok 7\\n\\0ok 7\\n"', 15]},
@@ -60,6 +63,12 @@ my @names = ("FIVE", {name=>"OK6", type=>"PV",},
              {name => "Yes", type=>"YES"},
              {name => "No", type=>"NO"},
              {name => "Undef", type=>"UNDEF"},
+# OK. It wasn't really designed to allow the creation of dual valued constants.
+# It was more for INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
+             {name=>"RFC1149", type=>"SV", value=>"sv_2mortal(temp_sv)",
+              pre=>"SV *temp_sv = newSVpv(RFC1149, 0); "
+              	   . "(void) SvUPGRADE(temp_sv,SVt_PVIV); SvIOK_on(temp_sv); "
+                   . "SvIVX(temp_sv) = 1149;"},
 );
 
 push @names, $_ foreach keys %compass;
@@ -76,7 +85,7 @@ my $XS_constant = XS_constant ($package, $types); # XS for ExtTest::constant
 my $header = catfile($dir, "test.h");
 push @files, "test.h";
 open FH, ">$header" or die "open >$header: $!\n";
-print FH <<'EOT';
+print FH <<"EOT";
 #define FIVE 5
 #define OK6 "ok 6\n"
 #define OK7 1
@@ -85,7 +94,7 @@ print FH <<'EOT';
 #define Yes 0
 #define No 1
 #define Undef 1
-
+#define RFC1149 "$parent_rfc1149"
 #undef NOTDEF
 
 EOT
@@ -299,6 +308,20 @@ if ($fail) {
 
 EOT
 
+print FH <<"EOT";
+my \$rfc1149 = RFC1149;
+if (\$rfc1149 ne "$parent_rfc1149") {
+  print "not ok 20 # '\$rfc1149' ne '$parent_rfc1149'\n";
+} else {
+  print "ok 20\n";
+}
+
+if (\$rfc1149 != 1149) {
+  printf "not ok 21 # %d != 1149\n", \$rfc1149;
+} else {
+  print "ok 21\n";
+}
+EOT
 close FH or die "close $testpl: $!\n";
 
 ################ Makefile.PL
@@ -374,7 +397,7 @@ if ($Config{usedl}) {
   }
 }
 
-my $test = 20;
+my $test = 22;
 my $maketest = "$make test";
 print "# make = '$maketest'\n";
 $makeout = `$maketest`;