This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add PERL_NO_GET_CONTEXT to Sys::Hostname
[perl5.git] / 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 /* swiped from POSIX.xs */
17 #if defined(__VMS) && !defined(__POSIX_SOURCE)
18 #  if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
19 #    include <utsname.h>
20 #  endif
21 #endif
22
23 #ifdef I_SYSUTSNAME
24 #  include <sys/utsname.h>
25 #endif
26
27 MODULE = Sys::Hostname          PACKAGE = Sys::Hostname
28
29 void
30 ghname()
31     PREINIT:
32     IV   retval = -1;
33     SV  *sv;
34     PPCODE:
35     EXTEND(SP, 1);
36 #ifdef HAS_GETHOSTNAME
37     {
38         char tmps[MAXHOSTNAMELEN];
39         retval = PerlSock_gethostname(tmps, sizeof(tmps));
40         sv = newSVpv(tmps, 0);
41     }
42 #else
43 #  ifdef HAS_PHOSTNAME
44     {
45         PerlIO *io;
46         char tmps[MAXHOSTNAMELEN];
47         char   *p = tmps;
48         char    c;
49         io = PerlProc_popen(PHOSTNAME, "r");
50         if (!io)
51             goto check_out;
52         while (PerlIO_read(io, &c, sizeof(c)) == 1) {
53             if (isSPACE(c) || p - tmps >= sizeof(tmps))
54                 break;
55             *p++ = c;
56         }
57         PerlProc_pclose(io);
58         retval = 0;
59         sv = newSVpvn(tmps, p - 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 = newSVpv(u.nodename, 0);
68         retval = 0;
69     }
70 #    endif
71 #  endif
72 #endif
73 #ifndef HAS_GETHOSTNAME
74     check_out:
75 #endif
76     if (retval == -1)
77         XSRETURN_UNDEF;
78     else
79         PUSHs(sv_2mortal(sv));