File Coverage

ext/Sys-Hostname/Hostname.xs
Criterion Covered Total %
statement 4 5 80.0
branch n/a
condition n/a
subroutine n/a
total 4 5 80.0


line stmt bran cond sub time code
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
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
20           # endif
21           #endif
22            
23           #ifdef I_SYSUTSNAME
24           # include
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 2         EXTEND(SP, 1);
36           #ifdef HAS_GETHOSTNAME
37           {
38           char tmps[MAXHOSTNAMELEN];
39           retval = PerlSock_gethostname(tmps, sizeof(tmps));
40 2         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 2         if (retval == -1)
77 0         XSRETURN_UNDEF;
78           else
79 2         PUSHs(sv_2mortal(sv));