r2364 - in packages: . libsys-hostname-long-perl
libsys-hostname-long-perl/branches
libsys-hostname-long-perl/branches/upstream
libsys-hostname-long-perl/branches/upstream/current
libsys-hostname-long-perl/branches/upstream/current/lib
libsys-hostname-long-perl/branches/upstream/current/lib/Sys
libsys-hostname-long-perl/branches/upstream/current/lib/Sys/Hostname
libsys-hostname-long-perl/branches/upstream/current/t
Krzysztof Krzyzaniak
eloy at costa.debian.org
Wed Mar 15 17:35:15 UTC 2006
Author: eloy
Date: 2006-03-15 17:35:14 +0000 (Wed, 15 Mar 2006)
New Revision: 2364
Added:
packages/libsys-hostname-long-perl/
packages/libsys-hostname-long-perl/branches/
packages/libsys-hostname-long-perl/branches/upstream/
packages/libsys-hostname-long-perl/branches/upstream/current/
packages/libsys-hostname-long-perl/branches/upstream/current/Changes
packages/libsys-hostname-long-perl/branches/upstream/current/MANIFEST
packages/libsys-hostname-long-perl/branches/upstream/current/Makefile.PL
packages/libsys-hostname-long-perl/branches/upstream/current/README
packages/libsys-hostname-long-perl/branches/upstream/current/lib/
packages/libsys-hostname-long-perl/branches/upstream/current/lib/Sys/
packages/libsys-hostname-long-perl/branches/upstream/current/lib/Sys/Hostname/
packages/libsys-hostname-long-perl/branches/upstream/current/lib/Sys/Hostname/Long.pm
packages/libsys-hostname-long-perl/branches/upstream/current/t/
packages/libsys-hostname-long-perl/branches/upstream/current/t/local.t
packages/libsys-hostname-long-perl/branches/upstream/current/testall.pl
packages/libsys-hostname-long-perl/tags/
Log:
[svn-inject] Installing original source of libsys-hostname-long-perl
Added: packages/libsys-hostname-long-perl/branches/upstream/current/Changes
===================================================================
--- packages/libsys-hostname-long-perl/branches/upstream/current/Changes 2006-03-15 17:20:20 UTC (rev 2363)
+++ packages/libsys-hostname-long-perl/branches/upstream/current/Changes 2006-03-15 17:35:14 UTC (rev 2364)
@@ -0,0 +1,4 @@
+Revision history for Perl extension Sys::Hostname::Long
+
+0.01 Sun Aug 26 18:07:52 2001
+
Added: packages/libsys-hostname-long-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libsys-hostname-long-perl/branches/upstream/current/MANIFEST 2006-03-15 17:20:20 UTC (rev 2363)
+++ packages/libsys-hostname-long-perl/branches/upstream/current/MANIFEST 2006-03-15 17:35:14 UTC (rev 2364)
@@ -0,0 +1,7 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/local.t
+testall.pl
+lib/Sys/Hostname/Long.pm
Added: packages/libsys-hostname-long-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libsys-hostname-long-perl/branches/upstream/current/Makefile.PL 2006-03-15 17:20:20 UTC (rev 2363)
+++ packages/libsys-hostname-long-perl/branches/upstream/current/Makefile.PL 2006-03-15 17:35:14 UTC (rev 2364)
@@ -0,0 +1,9 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ 'NAME' => 'Sys::Hostname::Long',
+ 'VERSION_FROM' => 'lib/Sys/Hostname/Long.pm',
+ 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/Sys/Hostname/Long.pm', # retrieve abstract from module
+ AUTHOR => 'Scott Penrose <scott at cpan.org>') : ()),
+);
Added: packages/libsys-hostname-long-perl/branches/upstream/current/README
===================================================================
--- packages/libsys-hostname-long-perl/branches/upstream/current/README 2006-03-15 17:20:20 UTC (rev 2363)
+++ packages/libsys-hostname-long-perl/branches/upstream/current/README 2006-03-15 17:35:14 UTC (rev 2364)
@@ -0,0 +1,24 @@
+Sys::Hostname::Long
+===================
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+ none
+
+COPYRIGHT AND LICENCE
+
+GNU
+
+Copyright (C) 2001 Scott Penrose <scottp at dd.com.au>
+ http://linux.dd.com.au/
+
+
+
Added: packages/libsys-hostname-long-perl/branches/upstream/current/lib/Sys/Hostname/Long.pm
===================================================================
--- packages/libsys-hostname-long-perl/branches/upstream/current/lib/Sys/Hostname/Long.pm 2006-03-15 17:20:20 UTC (rev 2363)
+++ packages/libsys-hostname-long-perl/branches/upstream/current/lib/Sys/Hostname/Long.pm 2006-03-15 17:35:14 UTC (rev 2364)
@@ -0,0 +1,499 @@
+package Sys::Hostname::Long;
+use strict;
+use Carp;
+
+require Exporter;
+use Sys::Hostname;
+
+# Use perl < 5.6 compatible methods for now, change to 'use base' soon
+ at Sys::Hostname::Long::ISA = qw/ Exporter Sys::Hostname /;
+
+# Use perl < 5.6 compatible methods for now, change to 'our' soon.
+use vars qw(@EXPORT $VERSION $hostlong %dispatch $lastdispatch);
+ at EXPORT = qw/ hostname_long /;
+$VERSION = '1.2';
+
+%dispatch = (
+
+ 'gethostbyname' => {
+ 'title' => 'Get Host by Name',
+ 'description' => '',
+ 'exec' => sub {
+ return gethostbyname('localhost');
+ },
+ },
+
+ 'exec_hostname' => {
+ 'title' => 'Execute "hostname"',
+ 'description' => '',
+ 'exec' => sub {
+ my $tmp = `hostname`;
+ $tmp =~ tr/\0\r\n//d;
+ return $tmp;
+ },
+ },
+
+ 'win32_registry1' => {
+ 'title' => 'WIN32 Registry',
+ 'description' => 'LMachine/System/CurrentControlSet/Service/VxD/MSTCP/Domain',
+ 'exec' => sub {
+ return eval q{
+ use Win32::TieRegistry ( TiedHash => '%RegistryHash' );
+ $RegistryHash{'LMachine'}{'System'}{'CurrentControlSet'}{'Services'}{'VxD'}{'MSTCP'}{'Domain'};
+ };
+ },
+ },
+
+ 'uname' => {
+ 'title' => 'POSIX::unae',
+ 'description' => '',
+ 'exec' => sub {
+ return eval {
+ local $SIG{__DIE__};
+ require POSIX;
+ (POSIX::uname())[1];
+ };
+ },
+ },
+
+ # XXX This is the same as above - what happened to the other one !!!
+ 'win32_registry2' => {
+ 'title' => 'WIN32 Registry',
+ 'description' => 'LMachine/System/CurrentControlSet/Services/VxD/MSTCP/Domain',
+ 'exec' => sub {
+ return eval q{
+ use Win32::TieRegistry ( TiedHash => '%RegistryHash' );
+ $RegistryHash{'LMachine'}{'System'}{'CurrentControlSet'}{'Services'}{'VxD'}{'MSTCP'}{'Domain'};
+ };
+ },
+ },
+
+ 'exec_hostname_fqdn' => {
+ 'title' => 'Execute "hostname --fqdn"',
+ 'description' => '',
+ 'exec' => sub {
+ my $tmp = `hostname --fqdn`;
+ $tmp =~ tr/\0\r\n//d;
+ return $tmp;
+ },
+ },
+
+ 'network' => {
+ 'title' => 'Network Socket hostname (not DNS)',
+ 'description' => '',
+ 'exec' => sub {
+ return eval q{
+ use IO::Socket;
+ my $s = IO::Socket::INET->new(
+ # m.root-servers.net (a remote IP number)
+ PeerAddr => '202.12.27.33',
+ # random safe port
+ PeerPort => 2000,
+ # We don't actually want to connect
+ Proto => 'udp',
+ ) or die "Faile socket - $!";
+ gethostbyaddr($s->sockaddr(), AF_INET);
+ };
+ },
+ },
+
+ 'ip' => {
+ 'title' => 'Network Socket IP then Hostname via DNS',
+ 'description' => '',
+ 'exec' => sub {
+ return eval q{
+ use IO::Socket;
+ my $s = IO::Socket::INET->new(
+ # m.root-servers.net (a remote IP number)
+ PeerAddr => '202.12.27.33',
+ # random safe port
+ PeerPort => 2000,
+ # We don't actually want to connect
+ Proto => 'udp',
+ ) or die "Faile socket - $!";
+ $s->sockhost;
+ };
+ },
+ },
+
+);
+
+# Dispatch from table
+sub dispatcher {
+ my ($method, @rest) = @_;
+ $lastdispatch = $method;
+ return $dispatch{$method}{exec}(@rest);
+}
+
+sub dispatch_keys {
+ return sort keys %dispatch;
+}
+
+sub dispatch_title {
+ return $dispatch{$_[0]}{title};
+}
+
+sub dispatch_description {
+ return $dispatch{$_[0]}{description};
+}
+
+sub hostname_long {
+ return $hostlong if defined $hostlong; # Cached copy (takes a while to lookup sometimes)
+ my ($ip, $debug) = @_;
+
+ $hostlong = dispatcher('uname');
+
+ unless ($hostlong =~ m|.*\..*|) {
+ if ($^O eq 'MacOS') {
+ # http://bumppo.net/lists/macperl/1999/03/msg00282.html
+ # suggests that it will work (checking localhost) on both
+ # Mac and Windows.
+ # Personally this makes no sense what so ever as
+ $hostlong = dispatcher('gethostbyname');
+
+ } elsif ($^O eq 'IRIX') { # XXX Patter match string !
+ $hostlong = dispatcher('exec_hostname');
+
+ } elsif ($^O eq 'cygwin') {
+ $hostlong = dispatcher('win32_registry1');
+
+ } elsif ($^O eq 'MSWin32') {
+ $hostlong = dispatcher('win32_registry2');
+
+ } elsif ($^O =~ m/(bsd|nto)/i) {
+ $hostlong = dispatcher('exec_hostname');
+
+ # (covered above) } elsif ($^O eq "darwin") {
+ # $hostlong = dispatcher('uname');
+
+ } else {
+ $hostlong = dispatcher('exec_hostname_fqdn');
+ }
+
+ if (!defined($hostlong) || $hostlong eq "") {
+ # FALL BACK - Requires working internet and DNS and reverse
+ # lookups of your IP number.
+ $hostlong = dispatcher('network');
+ }
+
+ if ($ip && !defined($hostlong) || $hostlong eq "") {
+ $hostlong = dispatcher('ip');
+ }
+ }
+ warn "Sys::Hostname::Long - Last Dispatch method = $lastdispatch" if ($debug);
+ return $hostlong;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Sys::Hostname::Long - Try every conceivable way to get full hostname
+
+=head1 SYNOPSIS
+
+ use Sys::Hostname::Long;
+ $host_long = hostname_long;
+
+=head1 DESCRIPTION
+
+How to get the host full name in perl on multiple operating systems (mac,
+windows, unix* etc)
+
+=head1 DISCUSSION
+
+This is the SECOND release of this code. It has an improved set of tests and
+improved interfaces - but it is still often failing to get a full host name.
+This of course is the reason I wrote the module, it is difficult to get full
+host names accurately on each system. On some systems (eg: Linux) it is
+dependent on the order of the entries in /etc/hosts.
+
+To make it easier to test I have testall.pl to generate an output list of all
+methods. Thus even if the logic is incorrect, it may be possible to get the
+full name.
+
+Attempt via many methods to get the systems full name. The L<Sys::Hostname>
+class is the best and standard way to get the system hostname. However it is
+missing the long hostname.
+
+Special thanks to B<David Sundstrom> and B<Greg Bacon> for the original
+L<Sys::Hostname>
+
+=head1 SUPPORT
+
+This is the original list of platforms tested.
+
+ MacOS Macintosh Classic OK
+ Win32 MS Windows (95,98,nt,2000...)
+ 98 OK
+ MacOS X Macintosh 10 OK
+ (other darwin) Probably OK (not tested)
+ Linux Linux UNIX OS OK
+ Sparc OK
+ HPUX H.P. Unix 10? Not Tested
+ Solaris SUN Solaris 7? OK
+ Irix SGI Irix 5? Not Tested
+ FreeBSD FreeBSD OK
+
+A new list has now been compiled of all the operating systems so that I can
+individually keep informaiton on their success.
+
+THIS IS IN NEED OF AN UPDATE AFTER NEXT RELEASE.
+
+=over 4
+
+=item Acorn - Not yet tested
+
+=item AIX - Not yet tested
+
+=item Amiga - Not yet tested
+
+=item Atari - Not yet tested
+
+=item AtheOS - Not yet tested
+
+=item BeOS - Not yet tested
+
+=item BSD - Not yet tested
+
+=item BSD/OS - Not yet tested
+
+=item Compaq - Not yet tested
+
+=item Cygwin - Not yet tested
+
+=item Concurrent - Not yet tested
+
+=item DG/UX - Not yet tested
+
+=item Digital - Not yet tested
+
+=item DEC OSF/1 - Not yet tested
+
+=item Digital UNIX - Not yet tested
+
+=item DYNIX/ptx - Not yet tested
+
+=item EPOC - Not yet tested
+
+=item FreeBSD - Not yet tested
+
+=item Fujitsu-Siemens - Not yet tested
+
+=item Guardian - Not yet tested
+
+=item HP - Not yet tested
+
+=item HP-UX - Not yet tested
+
+=item IBM - Not yet tested
+
+=item IRIX - Not yet tested - 3rd hand information might be ok.
+
+=item Japanese - Not yet tested
+
+=item JPerl - Not yet tested
+
+=item Linux
+
+=over 8
+
+=item Debian - Not yet tested
+
+=item Gentoo - Not yet tested
+
+=item Mandrake - Not yet tested
+
+=item Red Hat- Not yet tested
+
+=item Slackware - Not yet tested
+
+=item SuSe - Not yet tested
+
+=item Yellowdog - Not yet tested
+
+=back
+
+=item LynxOS - Not yet tested
+
+=item Mac OS - Not yet tested
+
+=item Mac OS X - OK 20040315 (v1.1)
+
+=item MachTen - Not yet tested
+
+=item Minix - Not yet tested
+
+=item MinGW - Not yet tested
+
+=item MiNT - Not yet tested
+
+=item MPE/iX - Not yet tested
+
+=item MS-DOS - Not yet tested
+
+=item MVS - Not yet tested
+
+=item NetBSD - Not yet tested
+
+=item NetWare - Not yet tested
+
+=item NEWS-OS - Not yet tested
+
+=item NextStep - Not yet tested
+
+=item Novell - Not yet tested
+
+=item NonStop - Not yet tested
+
+=item NonStop-UX - Not yet tested
+
+=item OpenBSD - Not yet tested
+
+=item ODT - Not yet tested
+
+=item OpenVMS - Not yet tested
+
+=item Open UNIX - Not yet tested
+
+=item OS/2 - Not yet tested
+
+=item OS/390 - Not yet tested
+
+=item OS/400 - Not yet tested
+
+=item OSF/1 - Not yet tested
+
+=item OSR - Not yet tested
+
+=item Plan 9 - Not yet tested
+
+=item Pocket PC - Not yet tested
+
+=item PowerMAX - Not yet tested
+
+=item Psion - Not yet tested
+
+=item QNX
+
+=over 8
+
+=item 4 - Not yet tested
+
+=item 6 (Neutrino) - Not yet tested
+
+=back
+
+=item Reliant UNIX - Not yet tested
+
+=item RISCOS - Not yet tested
+
+=item SCO - Not yet tested
+
+=item SGI - Not yet tested
+
+=item Symbian - Not yet tested
+
+=item Sequent - Not yet tested
+
+=item Siemens - Not yet tested
+
+=item SINIX - Not yet tested
+
+=item Solaris - Not yet tested
+
+=item SONY - Not yet tested
+
+=item Sun - Not yet tested
+
+=item Stratus - Not yet tested
+
+=item Tandem - Not yet tested
+
+=item Tru64 - Not yet tested
+
+=item Ultrix - Not yet tested
+
+=item UNIX - Not yet tested
+
+=item U/WIN - Not yet tested
+
+=item Unixware - Not yet tested
+
+=item VMS - Not yet tested
+
+=item VOS - Not yet tested
+
+=item Windows
+
+=over 8
+
+=item CE - Not yet tested
+
+=item 3.1 - Not yet tested
+
+=item 95 - Not yet tested
+
+=item 98 - Not yet tested
+
+=item Me - Not yet tested
+
+=item NT - Not yet tested
+
+=item 2000 - Not yet tested
+
+=item XP - Not yet tested
+
+=back
+
+=item z/OS - Not yet tested
+
+=back
+
+=head1 KNOWN LIMITATIONS
+
+=head2 Unix
+
+Most unix systems have trouble working out the fully quallified domain name as
+it to be configured somewhere in the system correctly. For example in most
+linux systems (debian, ?) the fully qualified name should be the first entry
+next to the ip number in /etc/hosts
+
+ 192.168.0.1 fred.somwhere.special fred
+
+If it is the other way around, it will fail.
+
+=head2 Mac
+
+=head1 TODO
+
+Contributions
+
+ David Dick
+ Graeme Hart
+
+ * Extra code from G
+ * Dispatch table
+ * List of all operating systems.
+
+Solaris
+ * Fall back 2 - TCP with DNS works ok
+ * Also can read /etc/defaultdomain file
+
+=head1 SEE ALSO
+
+ L<Sys::Hostname>
+
+=head1 AUTHOR
+
+Scott Penrose E<lt>F<scottp at dd.com.au>E<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001,2004 Scott Penrose. All rights reserved.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Added: packages/libsys-hostname-long-perl/branches/upstream/current/t/local.t
===================================================================
--- packages/libsys-hostname-long-perl/branches/upstream/current/t/local.t 2006-03-15 17:20:20 UTC (rev 2363)
+++ packages/libsys-hostname-long-perl/branches/upstream/current/t/local.t 2006-03-15 17:35:14 UTC (rev 2364)
@@ -0,0 +1,15 @@
+#!/usr/bin/perl -w
+use strict;
+use Test;
+
+use lib '../lib';
+use lib 'lib';
+
+BEGIN { plan tests => 1 }
+
+use Sys::Hostname::Long;
+
+my $hostname = hostname_long(1,1);
+ok($hostname ne "");
+
+print "Your hostname = $hostname\n";
Property changes on: packages/libsys-hostname-long-perl/branches/upstream/current/t/local.t
___________________________________________________________________
Name: svn:executable
+
Added: packages/libsys-hostname-long-perl/branches/upstream/current/testall.pl
===================================================================
--- packages/libsys-hostname-long-perl/branches/upstream/current/testall.pl 2006-03-15 17:20:20 UTC (rev 2363)
+++ packages/libsys-hostname-long-perl/branches/upstream/current/testall.pl 2006-03-15 17:35:14 UTC (rev 2364)
@@ -0,0 +1,32 @@
+#!/usr/bin/perl -w
+use strict;
+use Test;
+
+use lib '../lib';
+use lib 'lib';
+
+use Sys::Hostname::Long;
+
+format STDOUT_TOP =
+Method |Title |Result
+-----------------|---------------------------------|---------------------------------------
+.
+
+my ($method, $title, $ret);
+
+format STDOUT =
+@<<<<<<<<<<<<<<<<|@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<|@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+$method, $title, $ret
+.
+
+
+$ret = hostname_long();
+$method = "AUTOMATIC";
+$title = "via " . $Sys::Hostname::Long::lastdispatch;
+write;
+
+foreach $method (Sys::Hostname::Long::dispatch_keys()) {
+ $title = Sys::Hostname::Long::dispatch_title($method);
+ $ret = (Sys::Hostname::Long::dispatcher($method) || "");
+ write;
+}
Property changes on: packages/libsys-hostname-long-perl/branches/upstream/current/testall.pl
___________________________________________________________________
Name: svn:executable
+
More information about the Pkg-perl-cvs-commits
mailing list