This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add XS version of Sys::Hostname (from Greg Bacon
authorGurusamy Sarathy <gsar@cpan.org>
Tue, 15 Feb 2000 19:32:56 +0000 (19:32 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Tue, 15 Feb 2000 19:32:56 +0000 (19:32 +0000)
<gbacon@itsc.uah.edu>)

p4raw-id: //depot/perl@5110

MANIFEST
ext/DynaLoader/Makefile.PL
ext/Sys/Hostname/Hostname.pm [moved from lib/Sys/Hostname.pm with 78% similarity]
ext/Sys/Hostname/Hostname.xs [new file with mode: 0644]
ext/Sys/Hostname/Makefile.PL [new file with mode: 0644]
ext/Sys/Syslog/Makefile.PL
pod/perldelta.pod
t/lib/hostname.t
win32/Makefile
win32/makefile.mk

index ca222c0..170a879 100644 (file)
--- 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
index e4493b4..bcd45ae 100644 (file)
@@ -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 {
similarity index 78%
rename from lib/Sys/Hostname.pm
rename to ext/Sys/Hostname/Hostname.pm
index 63415a6..1efc897 100644 (file)
@@ -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<syscall(SYS_gethostname)>,
-C<`hostname`>, C<`uname -n`>, and the file F</com/host>.
-If all that fails it C<croak>s.
+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 E<lt>F<sunds@asictest.sc.ti.com>E<gt>
+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<syscall(SYS_gethostname)>, C<`hostname`>, C<`uname -n`>,
+and the file F</com/host>.  If all that fails it C<croak>s.
+
+All NULs, returns, and newlines are removed from the result.
+
+=head1 AUTHOR
+
+David Sundstrom E<lt>F<sunds@asictest.sc.ti.com>E<gt>
+
+Texas Instruments
+
+XS code added by Greg Bacon E<lt>F<gbacon@cs.uah.edu>E<gt>
+
+=cut
+
diff --git a/ext/Sys/Hostname/Hostname.xs b/ext/Sys/Hostname/Hostname.xs
new file mode 100644 (file)
index 0000000..98c07cf
--- /dev/null
@@ -0,0 +1,77 @@
+#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
+
+#if defined(HAS_UNAME) && !defined(WIN32)
+/* XXX need i_sys_utsname in config.sh */
+#  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 = 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 (file)
index 0000000..a0892f6
--- /dev/null
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME                => 'Sys::Hostname',
+    VERSION_FROM        => 'Hostname.pm', 
+    MAN3PODS           => {},  # Pods will be built by installman.
+    XSPROTOARG          => '-noprototypes',
+);
index 253130a..e5edf3e 100644 (file)
@@ -3,5 +3,6 @@ use ExtUtils::MakeMaker;
 WriteMakefile(
     NAME               => 'Sys::Syslog',
     VERSION_FROM       => 'Syslog.pm', 
+    MAN3PODS           => {},  # Pods will be built by installman.
     XSPROTOARG          => '-noprototypes',
 );
index ad4a8e7..46dd656 100644 (file)
@@ -532,10 +532,10 @@ C<oct()>:
 
 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<gt>('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<foo(10)->('bar')>.
+C<$foo[10]-E<gt>{'foo'}>.  Note however, that the arrow is still
+required for C<foo(10)-E<gt>('bar')>.
 
 =head2 exists() is supported on subroutine names
 
@@ -569,7 +569,7 @@ The length argument of C<syswrite()> 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<gt>[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<gt>{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
index 30dcf0f..6f61fb9 100755 (executable)
@@ -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";
 }
index 774e18b..015196f 100644 (file)
@@ -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
index 5e8a3ef..5fbc26d 100644 (file)
@@ -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