This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ext/attributes: use _memEQs() when comparing to string arguments
[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
f91101c9 15
13b3f787 16#ifdef I_SYSUTSNAME
f91101c9
GS
17# include <sys/utsname.h>
18#endif
19
20MODULE = Sys::Hostname PACKAGE = Sys::Hostname
35ffb081 21PROTOTYPES: DISABLE
f91101c9
GS
22
23void
24ghname()
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));
23933b71 34 sv = newSVpv(tmps, 0);
f91101c9
GS
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);
f91101c9 52 retval = 0;
23933b71 53 sv = newSVpvn(tmps, p - tmps);
f91101c9
GS
54 }
55# else
56# ifdef HAS_UNAME
57 {
58 struct utsname u;
59 if (PerlEnv_uname(&u) == -1)
60 goto check_out;
23933b71 61 sv = newSVpv(u.nodename, 0);
f91101c9
GS
62 retval = 0;
63 }
64# endif
65# endif
66#endif
8fa7f367 67#ifndef HAS_GETHOSTNAME
f91101c9 68 check_out:
8fa7f367 69#endif
f91101c9
GS
70 if (retval == -1)
71 XSRETURN_UNDEF;
72 else
73 PUSHs(sv_2mortal(sv));