ext/Sys-Hostname/Hostname.xs

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