[perl5.git] / ext / Sys-Hostname / Hostname.xs

#define PERL_NO_GET_CONTEXT

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#if defined(I_UNISTD) && defined(HAS_GETHOSTNAME)
# include <unistd.h>
#endif

/* a reasonable default */
#ifndef MAXHOSTNAMELEN
#  define MAXHOSTNAMELEN	256
#endif

/* swiped from POSIX.xs */
#if defined(__VMS) && !defined(__POSIX_SOURCE)
#  if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
#    include <utsname.h>
#  endif
#endif

#ifdef I_SYSUTSNAME
#  include <sys/utsname.h>
#endif

MODULE = Sys::Hostname		PACKAGE = Sys::Hostname

void
ghname()
    PREINIT:
    IV   retval = -1;
    SV  *sv;
    PPCODE:
    EXTEND(SP, 1);
#ifdef HAS_GETHOSTNAME
    {
	char tmps[MAXHOSTNAMELEN];
	retval = PerlSock_gethostname(tmps, sizeof(tmps));
	sv = newSVpv(tmps, 0);
    }
#else
#  ifdef HAS_PHOSTNAME
    {
	PerlIO *io;
	char tmps[MAXHOSTNAMELEN];
	char   *p = tmps;
        char    c;
	io = PerlProc_popen(PHOSTNAME, "r");
	if (!io)
	    goto check_out;
	while (PerlIO_read(io, &c, sizeof(c)) == 1) {
	    if (isSPACE(c) || p - tmps >= sizeof(tmps))
		break;
	    *p++ = c;
	}
	PerlProc_pclose(io);
	retval = 0;
	sv = newSVpvn(tmps, p - tmps);
    }
#  else
#    ifdef HAS_UNAME
    {
	struct utsname u;
	if (PerlEnv_uname(&u) == -1)
	    goto check_out;
	sv = newSVpv(u.nodename, 0);
        retval = 0;
    }
#    endif
#  endif
#endif
#ifndef HAS_GETHOSTNAME
    check_out:
#endif
    if (retval == -1)
	XSRETURN_UNDEF;
    else
	PUSHs(sv_2mortal(sv));
Commit	Line	Data
93659fa2 NC	1	#define PERL_NO_GET_CONTEXT
93659fa2 NC	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
	27	MODULE = Sys::Hostname PACKAGE = Sys::Hostname
	28
	29	void
	30	ghname()
	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));