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
CommitLineData
93659fa2
NC
1#define PERL_NO_GET_CONTEXT
2
f91101c9
GS
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
13b3f787 23#ifdef I_SYSUTSNAME
f91101c9
GS
24# include <sys/utsname.h>
25#endif
26
27MODULE = Sys::Hostname PACKAGE = Sys::Hostname
28
29void
30ghname()
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));
23933b71 40 sv = newSVpv(tmps, 0);
f91101c9
GS
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);
f91101c9 58 retval = 0;
23933b71 59 sv = newSVpvn(tmps, p - tmps);
f91101c9
GS
60 }
61# else
62# ifdef HAS_UNAME
63 {
64 struct utsname u;
65 if (PerlEnv_uname(&u) == -1)
66 goto check_out;
23933b71 67 sv = newSVpv(u.nodename, 0);
f91101c9
GS
68 retval = 0;
69 }
70# endif
71# endif
72#endif
8fa7f367 73#ifndef HAS_GETHOSTNAME
f91101c9 74 check_out:
8fa7f367 75#endif
f91101c9
GS
76 if (retval == -1)
77 XSRETURN_UNDEF;
78 else
79 PUSHs(sv_2mortal(sv));