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