← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:11:59 2013

Filename/usr/share/perl5/Sys/Hostname/Long.pm
StatementsExecuted 18 statements in 1.14ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11128µs34µsSys::Hostname::Long::::BEGIN@2Sys::Hostname::Long::BEGIN@2
11115µs91µsSys::Hostname::Long::::BEGIN@12Sys::Hostname::Long::BEGIN@12
11110µs54µsSys::Hostname::Long::::BEGIN@3Sys::Hostname::Long::BEGIN@3
1119µs38µ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;
2335µs240µs
# spent 34µs (28+6) within Sys::Hostname::Long::BEGIN@2 which was called: # once (28µs+6µs) by Mail::Sendmail::BEGIN@57 at line 2
use strict;
# spent 34µs making 1 call to Sys::Hostname::Long::BEGIN@2 # spent 6µs making 1 call to strict::import
3334µs298µs
# spent 54µs (10+44) within Sys::Hostname::Long::BEGIN@3 which was called: # once (10µs+44µs) by Mail::Sendmail::BEGIN@57 at line 3
use Carp;
# spent 54µs making 1 call to Sys::Hostname::Long::BEGIN@3 # spent 44µs making 1 call to Exporter::import
4
511µsrequire Exporter;
6355µs267µs
# spent 38µs (9+29) within Sys::Hostname::Long::BEGIN@6 which was called: # once (9µs+29µs) by Mail::Sendmail::BEGIN@57 at line 6
use Sys::Hostname;
# spent 38µs making 1 call to Sys::Hostname::Long::BEGIN@6 # spent 29µs making 1 call to Exporter::import
7
8# Use perl < 5.6 compatible methods for now, change to 'use base' soon
9115µs@Sys::Hostname::Long::ISA = qw/ Exporter Sys::Hostname /;
10
11# Use perl < 5.6 compatible methods for now, change to 'our' soon.
123957µs2167µs
# spent 91µs (15+76) within Sys::Hostname::Long::BEGIN@12 which was called: # once (15µs+76µs) by Mail::Sendmail::BEGIN@57 at line 12
use vars qw(@EXPORT $VERSION $hostlong %dispatch $lastdispatch);
# spent 91µs making 1 call to Sys::Hostname::Long::BEGIN@12 # spent 76µs making 1 call to vars::import
131700ns@EXPORT = qw/ hostname_long /;
141600ns$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 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
136129µ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
207112µs1;
208
209__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.