ext/Sys-Hostname/Hostname.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #if defined(I_UNISTD) && defined(HAS_GETHOSTNAME)
   6 # include <unistd.h>
   7 #endif
   8
   9 /* a reasonable default */
  10 #ifndef MAXHOSTNAMELEN
  11 #  define MAXHOSTNAMELEN        256
  12 #endif
  13
  14 /* swiped from POSIX.xs */
  15 #if defined(__VMS) && !defined(__POSIX_SOURCE)
  16 #  if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
  17 #    include <utsname.h>
  18 #  endif
  19 #endif
  20
  21 #ifdef I_SYSUTSNAME
  22 #  include <sys/utsname.h>
  23 #endif
  24
  25 MODULE = Sys::Hostname          PACKAGE = Sys::Hostname
  26
  27 void
  28 ghname()
  29     PREINIT:
  30     IV   retval = -1;
  31     SV  *sv;
  32     PPCODE:
  33     EXTEND(SP, 1);
  34 #ifdef HAS_GETHOSTNAME
  35     {
  36         char tmps[MAXHOSTNAMELEN];
  37         retval = PerlSock_gethostname(tmps, sizeof(tmps));
  38         sv = newSVpvn(tmps, strlen(tmps));
  39     }
  40 #else
  41 #  ifdef HAS_PHOSTNAME
  42     {
  43         PerlIO *io;
  44         char tmps[MAXHOSTNAMELEN];
  45         char   *p = tmps;
  46         char    c;
  47         io = PerlProc_popen(PHOSTNAME, "r");
  48         if (!io)
  49             goto check_out;
  50         while (PerlIO_read(io, &c, sizeof(c)) == 1) {
  51             if (isSPACE(c) || p - tmps >= sizeof(tmps))
  52                 break;
  53             *p++ = c;
  54         }
  55         PerlProc_pclose(io);
  56         *p = '\0';
  57         retval = 0;
  58         sv = newSVpvn(tmps, strlen(tmps));
  59     }
  60 #  else
  61 #    ifdef HAS_UNAME
  62     {
  63         struct utsname u;
  64         if (PerlEnv_uname(&u) == -1)
  65             goto check_out;
  66         sv = newSVpvn(u.nodename, strlen(u.nodename));
  67         retval = 0;
  68     }
  69 #    endif
  70 #  endif
  71 #endif
  72 #ifndef HAS_GETHOSTNAME
  73     check_out:
  74 #endif
  75     if (retval == -1)
  76         XSRETURN_UNDEF;
  77     else
  78         PUSHs(sv_2mortal(sv));