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 #ifdef I_SYSUTSNAME
17 #  include <sys/utsname.h>
18 #endif
19 
20 MODULE = Sys::Hostname		PACKAGE = Sys::Hostname
21 PROTOTYPES: DISABLE
22 
23 void
24 ghname()
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));
34 	sv = newSVpv(tmps, 0);
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);
52 	retval = 0;
53 	sv = newSVpvn(tmps, p - tmps);
54     }
55 #  else
56 #    ifdef HAS_UNAME
57     {
58 	struct utsname u;
59 	if (PerlEnv_uname(&u) == -1)
60 	    goto check_out;
61 	sv = newSVpv(u.nodename, 0);
62         retval = 0;
63     }
64 #    endif
65 #  endif
66 #endif
67 #ifndef HAS_GETHOSTNAME
68     check_out:
69 #endif
70     if (retval == -1)
71 	XSRETURN_UNDEF;
72     else
73 	PUSHs(sv_2mortal(sv));
74