This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add XS version of Sys::Hostname (from Greg Bacon
[perl5.git] / 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 #if defined(HAS_UNAME) && !defined(WIN32)
22 /* XXX need i_sys_utsname in config.sh */
23 #  include <sys/utsname.h>
24 #endif
25
26 MODULE = Sys::Hostname          PACKAGE = Sys::Hostname
27
28 void
29 ghname()
30     PREINIT:
31     IV   retval = -1;
32     SV  *sv;
33     PPCODE:
34     EXTEND(SP, 1);
35 #ifdef HAS_GETHOSTNAME
36     {
37         char tmps[MAXHOSTNAMELEN];
38         retval = PerlSock_gethostname(tmps, sizeof(tmps));
39         sv = newSVpvn(tmps, strlen(tmps));
40     }
41 #else
42 #  ifdef HAS_PHOSTNAME
43     {
44         PerlIO *io;
45         char tmps[MAXHOSTNAMELEN];
46         char   *p = tmps;
47         char    c;
48         io = PerlProc_popen(PHOSTNAME, "r");
49         if (!io)
50             goto check_out;
51         while (PerlIO_read(io, &c, sizeof(c)) == 1) {
52             if (isSPACE(c) || p - tmps >= sizeof(tmps))
53                 break;
54             *p++ = c;
55         }
56         PerlProc_pclose(io);
57         *p = '\0';
58         retval = 0;
59         sv = newSVpvn(tmps, strlen(tmps));
60     }
61 #  else
62 #    ifdef HAS_UNAME
63     {
64         struct utsname u;
65         if (PerlEnv_uname(&u) == -1)
66             goto check_out;
67         sv = newSVpvn(u.nodename, strlen(u.nodename));
68         retval = 0;
69     }
70 #    endif
71 #  endif
72 #endif
73     check_out:
74     if (retval == -1)
75         XSRETURN_UNDEF;
76     else
77         PUSHs(sv_2mortal(sv));