← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:50 2015

Filename/usr/share/perl5/Sys/Hostname/Long.pm
StatementsExecuted 14 statements in 682µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11111µs22µsSys::Hostname::Long::::BEGIN@2Sys::Hostname::Long::BEGIN@2
1118µs34µsSys::Hostname::Long::::BEGIN@3Sys::Hostname::Long::BEGIN@3
1116µs51µsSys::Hostname::Long::::BEGIN@12Sys::Hostname::Long::BEGIN@12
1116µs23µsSys::Hostname::Long::::BEGIN@6Sys::Hostname::Long::BEGIN@6
0000s0sSys::Hostname::Long::::__ANON__[:114]Sys::Hostname::Long::__ANON__[:114]
0000s0sSys::Hostname::Long::::__ANON__[:133]Sys::Hostname::Long::__ANON__[:133]
0000s0sSys::Hostname::Long::::__ANON__[:23]Sys::Hostname::Long::__ANON__[:23]
0000s0sSys::Hostname::Long::::__ANON__[:33]Sys::Hostname::Long::__ANON__[:33]
0000s0sSys::Hostname::Long::::__ANON__[:44]Sys::Hostname::Long::__ANON__[:44]
0000s0sSys::Hostname::Long::::__ANON__[:56]Sys::Hostname::Long::__ANON__[:56]
0000s0sSys::Hostname::Long::::__ANON__[:68]Sys::Hostname::Long::__ANON__[:68]
0000s0sSys::Hostname::Long::::__ANON__[:84]Sys::Hostname::Long::__ANON__[:84]
0000s0sSys::Hostname::Long::::__ANON__[:94]Sys::Hostname::Long::__ANON__[:94]
0000s0sSys::Hostname::Long::::dispatch_descriptionSys::Hostname::Long::dispatch_description
0000s0sSys::Hostname::Long::::dispatch_keysSys::Hostname::Long::dispatch_keys
0000s0sSys::Hostname::Long::::dispatch_titleSys::Hostname::Long::dispatch_title
0000s0sSys::Hostname::Long::::dispatcherSys::Hostname::Long::dispatcher
0000s0sSys::Hostname::Long::::hostname_longSys::Hostname::Long::hostname_long
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Sys::Hostname::Long;
2223µs233µs
# spent 22µs (11+11) within Sys::Hostname::Long::BEGIN@2 which was called: # once (11µs+11µs) by Mail::Sendmail::BEGIN@57 at line 2
use strict;
# spent 22µs making 1 call to Sys::Hostname::Long::BEGIN@2 # spent 11µs making 1 call to strict::import
3226µs260µs
# spent 34µs (8+26) within Sys::Hostname::Long::BEGIN@3 which was called: # once (8µs+26µs) by Mail::Sendmail::BEGIN@57 at line 3
use Carp;
# spent 34µs making 1 call to Sys::Hostname::Long::BEGIN@3 # spent 26µs making 1 call to Exporter::import
4
51600nsrequire Exporter;
6236µs239µs
# spent 23µs (6+16) within Sys::Hostname::Long::BEGIN@6 which was called: # once (6µs+16µs) by Mail::Sendmail::BEGIN@57 at line 6
use Sys::Hostname;
# spent 23µs making 1 call to Sys::Hostname::Long::BEGIN@6 # spent 16µs making 1 call to Exporter::import
7
8# Use perl < 5.6 compatible methods for now, change to 'use base' soon
916µs@Sys::Hostname::Long::ISA = qw/ Exporter Sys::Hostname /;
10
11# Use perl < 5.6 compatible methods for now, change to 'our' soon.
122566µs296µs
# spent 51µs (6+45) within Sys::Hostname::Long::BEGIN@12 which was called: # once (6µs+45µs) by Mail::Sendmail::BEGIN@57 at line 12
use vars qw(@EXPORT $VERSION $hostlong %dispatch $lastdispatch);
# spent 51µs making 1 call to Sys::Hostname::Long::BEGIN@12 # spent 45µs making 1 call to vars::import
131500ns@EXPORT = qw/ hostname_long /;
141200ns$VERSION = '1.4';
15
16%dispatch = (
17
18 'gethostbyname' => {
19 'title' => 'Get Host by Name',
20 'description' => '',
21 'exec' => sub {
22 return gethostbyname('localhost');
23 },
24 },
25
26 'exec_hostname' => {
27 'title' => 'Execute "hostname"',
28 'description' => '',
29 'exec' => sub {
30 my $tmp = `hostname`;
31 $tmp =~ tr/\0\r\n//d;
32 return $tmp;
33 },
34 },
35
36 'win32_registry1' => {
37 'title' => 'WIN32 Registry',
38 'description' => 'LMachine/System/CurrentControlSet/Service/VxD/MSTCP/Domain',
39 'exec' => sub {
40 return eval q{
41 use Win32::TieRegistry ( TiedHash => '%RegistryHash' );
42 $RegistryHash{'LMachine'}{'System'}{'CurrentControlSet'}{'Services'}{'VxD'}{'MSTCP'}{'Domain'};
43 };
44 },
45 },
46
47 'uname' => {
48 'title' => 'POSIX::unae',
49 'description' => '',
50 'exec' => sub {
51 return eval {
52 local $SIG{__DIE__};
53 require POSIX;
54 (POSIX::uname())[1];
55 };
56 },
57 },
58
59 # XXX This is the same as above - what happened to the other one !!!
60 'win32_registry2' => {
61 'title' => 'WIN32 Registry',
62 'description' => 'LMachine/System/CurrentControlSet/Services/VxD/MSTCP/Domain',
63 'exec' => sub {
64 return eval q{
65 use Win32::TieRegistry ( TiedHash => '%RegistryHash' );
66 $RegistryHash{'LMachine'}{'System'}{'CurrentControlSet'}{'Services'}{'VxD'}{'MSTCP'}{'Domain'};
67 };
68 },
69 },
70
71 'exec_hostname_fqdn' => {
72 'title' => 'Execute "hostname --fqdn"',
73 'description' => '',
74 'exec' => sub {
75 # Skip for Solaris, and only run as non-root
76 my $tmp;
77 if ($< == 0) {
78 $tmp = `su -s /bin/sh nobody -c "hostname --fqdn"`;
79 } else {
80 $tmp = `hostname --fqdn`;
81 }
82 $tmp =~ tr/\0\r\n//d;
83 return $tmp;
84 },
85 },
86
87 'exec_hostname_domainname' => {
88 'title' => 'Execute "hostname" and "domainname"',
89 'description' => '',
90 'exec' => sub {
91 my $tmp = `hostname` . '.' . `domainname`;
92 $tmp =~ tr/\0\r\n//d;
93 return $tmp;
94 },
95 },
96
97
98 'network' => {
99 'title' => 'Network Socket hostname (not DNS)',
100 'description' => '',
101 'exec' => sub {
102 return eval q{
103 use IO::Socket;
104 my $s = IO::Socket::INET->new(
105 # m.root-servers.net (a remote IP number)
106 PeerAddr => '202.12.27.33',
107 # random safe port
108 PeerPort => 2000,
109 # We don't actually want to connect
110 Proto => 'udp',
111 ) or die "Faile socket - $!";
112 gethostbyaddr($s->sockaddr(), AF_INET);
113 };
114 },
115 },
116
117 'ip' => {
118 'title' => 'Network Socket IP then Hostname via DNS',
119 'description' => '',
120 'exec' => sub {
121 return eval q{
122 use IO::Socket;
123 my $s = IO::Socket::INET->new(
124 # m.root-servers.net (a remote IP number)
125 PeerAddr => '202.12.27.33',
126 # random safe port
127 PeerPort => 2000,
128 # We don't actually want to connect
129 Proto => 'udp',
130 ) or die "Faile socket - $!";
131 $s->sockhost;
132 };
133 },
134 },
135
136116µs);
137
138# Dispatch from table
139sub dispatcher {
140 my ($method, @rest) = @_;
141 $lastdispatch = $method;
142 return $dispatch{$method}{exec}(@rest);
143}
144
145sub dispatch_keys {
146 return sort keys %dispatch;
147}
148
149sub dispatch_title {
150 return $dispatch{$_[0]}{title};
151}
152
153sub dispatch_description {
154 return $dispatch{$_[0]}{description};
155}
156
157sub hostname_long {
158 return $hostlong if defined $hostlong; # Cached copy (takes a while to lookup sometimes)
159 my ($ip, $debug) = @_;
160
161 $hostlong = dispatcher('uname');
162
163 unless ($hostlong =~ m|.*\..*|) {
164 if ($^O eq 'MacOS') {
165 # http://bumppo.net/lists/macperl/1999/03/msg00282.html
166 # suggests that it will work (checking localhost) on both
167 # Mac and Windows.
168 # Personally this makes no sense what so ever as
169 $hostlong = dispatcher('gethostbyname');
170
171 } elsif ($^O eq 'IRIX') { # XXX Patter match string !
172 $hostlong = dispatcher('exec_hostname');
173
174 } elsif ($^O eq 'cygwin') {
175 $hostlong = dispatcher('win32_registry1');
176
177 } elsif ($^O eq 'MSWin32') {
178 $hostlong = dispatcher('win32_registry2');
179
180 } elsif ($^O =~ m/(bsd|nto)/i) {
181 $hostlong = dispatcher('exec_hostname');
182
183 # (covered above) } elsif ($^O eq "darwin") {
184 # $hostlong = dispatcher('uname');
185
186 } elsif ($^O eq 'solaris') {
187 $hostlong = dispatcher('exec_hostname_domainname');
188
189 } else {
190 $hostlong = dispatcher('exec_hostname_fqdn');
191 }
192
193 if (!defined($hostlong) || $hostlong eq "") {
194 # FALL BACK - Requires working internet and DNS and reverse
195 # lookups of your IP number.
196 $hostlong = dispatcher('network');
197 }
198
199 if ($ip && !defined($hostlong) || $hostlong eq "") {
200 $hostlong = dispatcher('ip');
201 }
202 }
203 warn "Sys::Hostname::Long - Last Dispatch method = $lastdispatch" if ($debug);
204 return $hostlong;
205}
206
20717µs1;
208
209__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.