From: Gurusamy Sarathy Date: Tue, 15 Feb 2000 19:32:56 +0000 (+0000) Subject: add XS version of Sys::Hostname (from Greg Bacon X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f91101c94610d6a9ffa5537a656223948d7d5d1f;p=p5sagit%2Fp5-mst-13.2.git add XS version of Sys::Hostname (from Greg Bacon ) p4raw-id: //depot/perl@5110 --- diff --git a/MANIFEST b/MANIFEST index ca222c0..170a879 100644 --- a/MANIFEST +++ b/MANIFEST @@ -364,6 +364,9 @@ ext/SDBM_File/typemap SDBM extension interface types ext/Socket/Makefile.PL Socket extension makefile writer ext/Socket/Socket.pm Socket extension Perl module ext/Socket/Socket.xs Socket extension external subroutines +ext/Sys/Hostname/Makefile.PL Sys::Hostname extension makefile writer +ext/Sys/Hostname/Hostname.pm Sys::Hostname extension Perl module +ext/Sys/Hostname/Hostname.xs Sys::Hostname extension external subroutines ext/Sys/Syslog/Makefile.PL Sys::Syslog extension makefile writer ext/Sys/Syslog/Syslog.pm Sys::Syslog extension Perl module ext/Sys/Syslog/Syslog.xs Sys::Syslog extension external subroutines @@ -646,7 +649,6 @@ lib/SelectSaver.pm Enforce proper select scoping lib/SelfLoader.pm Load functions only on demand lib/Shell.pm Make AUTOLOADed system() calls lib/Symbol.pm Symbol table manipulation routines -lib/Sys/Hostname.pm Hostname methods lib/Term/Cap.pm Perl module supporting termcap usage lib/Term/Complete.pm A command completion subroutine lib/Term/ReadLine.pm Stub readline library diff --git a/ext/DynaLoader/Makefile.PL b/ext/DynaLoader/Makefile.PL index e4493b4..bcd45ae 100644 --- a/ext/DynaLoader/Makefile.PL +++ b/ext/DynaLoader/Makefile.PL @@ -12,7 +12,8 @@ WriteMakefile( 'XSLoader_pm.PL'=>'XSLoader.pm'}, PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm', 'XSLoader.pm' => '$(INST_LIBDIR)/XSLoader.pm'}, - clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm'}, + clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm ' . + 'XSLoader.pm'}, ); sub MY::postamble { diff --git a/lib/Sys/Hostname.pm b/ext/Sys/Hostname/Hostname.pm similarity index 78% rename from lib/Sys/Hostname.pm rename to ext/Sys/Hostname/Hostname.pm index 63415a6..1efc897 100644 --- a/lib/Sys/Hostname.pm +++ b/ext/Sys/Hostname/Hostname.pm @@ -1,41 +1,31 @@ package Sys::Hostname; -use Carp; -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(hostname); - -=head1 NAME - -Sys::Hostname - Try every conceivable way to get hostname - -=head1 SYNOPSIS - - use Sys::Hostname; - $host = hostname; - -=head1 DESCRIPTION +use strict; -Attempts several methods of getting the system hostname and -then caches the result. It tries C, -C<`hostname`>, C<`uname -n`>, and the file F. -If all that fails it Cs. +use Carp; -All nulls, returns, and newlines are removed from the result. +require Exporter; +use XSLoader (); +require AutoLoader; -=head1 AUTHOR +our @ISA = qw/ Exporter AutoLoader /; +our @EXPORT = qw/ hostname /; -David Sundstrom EFE +our $VERSION = '1.1'; -Texas Instruments +our $host; -=cut +XSLoader::load 'Sys::Hostname', $VERSION; sub hostname { # method 1 - we already know it return $host if defined $host; + # method 1' - try to ask the system + $host = ghname(); + return $host if defined $host; + if ($^O eq 'VMS') { # method 2 - no sockets ==> return DECnet node name @@ -70,8 +60,10 @@ sub hostname { return $host; } else { # Unix + # is anyone going to make it here? # method 2 - syscall is preferred since it avoids tainting problems + # XXX: is it such a good idea to return hostname untainted? eval { local $SIG{__DIE__}; require "syscall.ph"; @@ -113,6 +105,7 @@ sub hostname { # method 6 - Apollo pre-SR10 || eval { local $SIG{__DIE__}; + my($a,$b,$c,$d); ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6); } @@ -126,3 +119,35 @@ sub hostname { } 1; + +__END__ + +=head1 NAME + +Sys::Hostname - Try every conceivable way to get hostname + +=head1 SYNOPSIS + + use Sys::Hostname; + $host = hostname; + +=head1 DESCRIPTION + +Attempts several methods of getting the system hostname and +then caches the result. It tries the first available of the C +library's gethostname(), C<`$Config{aphostname}`>, uname(2), +C, C<`hostname`>, C<`uname -n`>, +and the file F. If all that fails it Cs. + +All NULs, returns, and newlines are removed from the result. + +=head1 AUTHOR + +David Sundstrom EFE + +Texas Instruments + +XS code added by Greg Bacon EFE + +=cut + diff --git a/ext/Sys/Hostname/Hostname.xs b/ext/Sys/Hostname/Hostname.xs new file mode 100644 index 0000000..98c07cf --- /dev/null +++ b/ext/Sys/Hostname/Hostname.xs @@ -0,0 +1,77 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#if defined(I_UNISTD) && defined(HAS_GETHOSTNAME) +# include +#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 +# endif +#endif + +#if defined(HAS_UNAME) && !defined(WIN32) +/* XXX need i_sys_utsname in config.sh */ +# include +#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 = newSVpvn(tmps, strlen(tmps)); + } +#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); + *p = '\0'; + retval = 0; + sv = newSVpvn(tmps, strlen(tmps)); + } +# else +# ifdef HAS_UNAME + { + struct utsname u; + if (PerlEnv_uname(&u) == -1) + goto check_out; + sv = newSVpvn(u.nodename, strlen(u.nodename)); + retval = 0; + } +# endif +# endif +#endif + check_out: + if (retval == -1) + XSRETURN_UNDEF; + else + PUSHs(sv_2mortal(sv)); diff --git a/ext/Sys/Hostname/Makefile.PL b/ext/Sys/Hostname/Makefile.PL new file mode 100644 index 0000000..a0892f6 --- /dev/null +++ b/ext/Sys/Hostname/Makefile.PL @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Sys::Hostname', + VERSION_FROM => 'Hostname.pm', + MAN3PODS => {}, # Pods will be built by installman. + XSPROTOARG => '-noprototypes', +); diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL index 253130a..e5edf3e 100644 --- a/ext/Sys/Syslog/Makefile.PL +++ b/ext/Sys/Syslog/Makefile.PL @@ -3,5 +3,6 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Sys::Syslog', VERSION_FROM => 'Syslog.pm', + MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', ); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index ad4a8e7..46dd656 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -532,10 +532,10 @@ C: Perl now allows the arrow to be omitted in many constructs involving subroutine calls through references. For example, -C<$foo[10]->('foo')> may now be written C<$foo[10]('foo')>. +C<$foo[10]-E('foo')> may now be written C<$foo[10]('foo')>. This is rather similar to how the arrow may be omitted from -C<$foo[10]->{'foo'}>. Note however, that the arrow is still -required for C('bar')>. +C<$foo[10]-E{'foo'}>. Note however, that the arrow is still +required for C('bar')>. =head2 exists() is supported on subroutine names @@ -569,7 +569,7 @@ The length argument of C has become optional. =head2 File and directory handles can be autovivified -Similar to how constructs such as C<$x->[0]> autovivify a reference, +Similar to how constructs such as C<$x-E[0]> autovivify a reference, handle constructors (open(), opendir(), pipe(), socketpair(), sysopen(), socket(), and accept()) now autovivify a file or directory handle if the handle passed to them is an uninitialized scalar variable. This @@ -966,7 +966,7 @@ array element in that slot. =head2 Pseudo-hashes work better Dereferencing some types of reference values in a pseudo-hash, -such as C<$ph->{foo}[1]>, was accidentally disallowed. This has +such as C<$ph-E{foo}[1]>, was accidentally disallowed. This has been corrected. When applied to a pseudo-hash element, exists() now reports whether @@ -1627,6 +1627,11 @@ fixed. Sys::Syslog now uses XSUBs to access facilities from syslog.h so it no longer requires syslog.ph to exist. +=item Sys::Hostname + +Sys::Hostname now uses XSUBs to call the C library's gethostname() or +uname() if they exist. + =item Time::Local The timelocal() and timegm() functions used to silently return bogus diff --git a/t/lib/hostname.t b/t/lib/hostname.t index 30dcf0f..6f61fb9 100755 --- a/t/lib/hostname.t +++ b/t/lib/hostname.t @@ -15,5 +15,6 @@ if ($@) { print "1..0\n" if $@ =~ /Cannot get host name/; } else { print "1..1\n"; + print "# \$host = `$host'\n"; print "ok 1\n"; } diff --git a/win32/Makefile b/win32/Makefile index 774e18b..015196f 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -621,7 +621,8 @@ SETARGV_OBJ = setargv$(o) !ENDIF DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ - Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob + Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ + Sys/Hostname STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -642,6 +643,7 @@ PEEK = $(EXTDIR)\Devel\Peek\Peek BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader DPROF = $(EXTDIR)\Devel\DProf\DProf GLOB = $(EXTDIR)\File\Glob\Glob +HOSTNAME = $(EXTDIR)\Sys\Hostname\Hostname SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -658,6 +660,7 @@ RE_DLL = $(AUTODIR)\re\re.dll BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll DPROF_DLL = $(AUTODIR)\Devel\DProf\DProf.dll GLOB_DLL = $(AUTODIR)\File\Glob\Glob.dll +HOSTNAME_DLL = $(AUTODIR)\Sys\Hostname\Hostname.dll ERRNO_PM = $(LIBDIR)\Errno.pm @@ -676,7 +679,8 @@ EXTENSION_C = \ $(B).c \ $(BYTELOADER).c \ $(DPROF).c \ - $(GLOB).c + $(GLOB).c \ + $(HOSTNAME).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -693,7 +697,8 @@ EXTENSION_DLL = \ $(THREAD_DLL) \ $(BYTELOADER_DLL) \ $(DPROF_DLL) \ - $(GLOB_DLL) + $(GLOB_DLL) \ + $(HOSTNAME_DLL) EXTENSION_PM = \ $(ERRNO_PM) @@ -958,6 +963,12 @@ $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs $(MAKE) cd ..\..\win32 +$(HOSTNAME_DLL): $(PERLEXE) $(HOSTNAME).xs + cd $(EXTDIR)\Sys\$(*B) + ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\..\win32 + $(BYTELOADER_DLL): $(PERLEXE) $(BYTELOADER).xs cd $(EXTDIR)\$(*B) ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl diff --git a/win32/makefile.mk b/win32/makefile.mk index 5e8a3ef..5fbc26d 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -742,7 +742,8 @@ SETARGV_OBJ = setargv$(o) .ENDIF DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ - Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob + Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ + Sys/Hostname STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -763,6 +764,7 @@ PEEK = $(EXTDIR)\Devel\Peek\Peek BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader DPROF = $(EXTDIR)\Devel\DProf\DProf GLOB = $(EXTDIR)\File\Glob\Glob +HOSTNAME = $(EXTDIR)\Sys\Hostname\Hostname SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -779,6 +781,7 @@ RE_DLL = $(AUTODIR)\re\re.dll BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll DPROF_DLL = $(AUTODIR)\Devel\DProf\DProf.dll GLOB_DLL = $(AUTODIR)\File\Glob\Glob.dll +HOSTNAME_DLL = $(AUTODIR)\Sys\Hostname\Hostname.dll ERRNO_PM = $(LIBDIR)\Errno.pm @@ -797,7 +800,8 @@ EXTENSION_C = \ $(B).c \ $(BYTELOADER).c \ $(DPROF).c \ - $(GLOB).c + $(GLOB).c \ + $(HOSTNAME).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -814,7 +818,8 @@ EXTENSION_DLL = \ $(THREAD_DLL) \ $(BYTELOADER_DLL) \ $(DPROF_DLL) \ - $(GLOB_DLL) + $(GLOB_DLL) \ + $(HOSTNAME_DLL) EXTENSION_PM = \ $(ERRNO_PM) @@ -1183,6 +1188,11 @@ $(SOCKET_DLL): $(PERLEXE) $(SOCKET).xs ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl cd $(EXTDIR)\$(*B) && $(MAKE) +$(HOSTNAME_DLL): $(PERLEXE) $(HOSTNAME).xs + cd $(EXTDIR)\Sys\$(*B) && \ + ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\Sys\$(*B) && $(MAKE) + $(BYTELOADER_DLL): $(PERLEXE) $(BYTELOADER).xs cd $(EXTDIR)\$(*B) && \ ..\..\miniperl -I..\..\lib Makefile.PL INSTALLDIRS=perl