This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
authorNicholas Clark <nick@ccl4.org>
Thu, 14 Jun 2001 23:52:56 +0000 (00:52 +0100)
committerJarkko Hietaniemi <jhi@iki.fi>
Fri, 15 Jun 2001 13:21:18 +0000 (13:21 +0000)
Message-ID: <20010614235256.G98663@plum.flirble.org>

p4raw-id: //depot/perl@10601

ext/Socket/Socket.pm
ext/Socket/Socket.xs
lib/ExtUtils/Constant.pm
t/lib/extutils.t

index 2b2c03e..06d8c74 100644 (file)
@@ -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;
 }
 
index 30dd0f2..3bc472b 100644 (file)
@@ -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));
-       }
index 41341c9..024d8cc 100644 (file)
@@ -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<strlen>
 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<PV>
 
+=item PVN
+
+A B<mortal> SV.
+
 =item YES
 
 Truth.  (C<PL_sv_yes>)  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<TYPE> is aggregate
 (eg I<PVN> expects both pointer and length) then there should be multiple
-I<VALUE>s for the components.
+I<VALUE>s for the components. I<PRE> and I<POST> if defined give snippets
+of C code to preceed and follow the assignment. I<PRE> will be at the start
+of a block, so variables may be defined in it.
 
 =cut
 
@@ -222,7 +230,18 @@ I<VALUE>s 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<MACRO> defaults to
 I<VALUE> when not defined.  If I<TYPE> is aggregate (eg I<PVN> expects both
@@ -249,17 +275,20 @@ values in the order expected by the type.  C<C_constant> will always call
 this function with I<MACRO> defined, defaulting to the constant's name.
 I<DEFAULT> if defined is an array reference giving default type and and
 value(s) if the clause generated by I<MACRO> doesn't evaluate to true.
+The two pairs I<PRE> and I<POST> 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 C<croak>ing 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<struct>
+and return this as I<value>. 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<pre>.
+Rarely needed.
+
+=item def_pre
+=item def_post
+
+Equivalents of I<pre> and I<post> for the default value.
+
 =back
 
 I<PACKAGE> 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";
index fa256af..be03cb1 100644 (file)
@@ -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`;