File Coverage

blib/lib/FusionInventory/Agent/Tools/Hostname.pm
Criterion Covered Total %
statement 28 37 75.6
branch 3 6 50.0
condition 0 3 0.0
subroutine 10 11 90.9
pod 1 1 100.0
total 42 58 72.4


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::Tools::Hostname;
2              
3 32     32   6231451 use strict;
  32         42  
  32         700  
4 32     32   88 use warnings;
  32         35  
  32         654  
5 32     32   95 use base 'Exporter';
  32         73  
  32         1854  
6              
7 32     32   119 use UNIVERSAL::require();
  32         48  
  32         394  
8 32     32   604 use Encode;
  32         7511  
  32         1927  
9 32     32   120 use English qw(-no_match_vars);
  32         28  
  32         153  
10              
11             our @EXPORT = qw(
12             getHostname
13             );
14              
15             BEGIN {
16 32 50   32   5828 if ($OSNAME eq 'MSWin32') {
17 32     32   9983 no warnings 'redefine'; ## no critic (ProhibitNoWarnings)
  32         41  
  32         1978  
18 0         0 Win32::API->require();
19             # Kernel32.dll is used more or less everywhere.
20             # Without this, Win32::API will release the DLL even
21             # if it's a very bad idea
22 0         0 *Win32::API::DESTROY = sub {};
23             }
24             }
25              
26             sub getHostname {
27 1     1 1 2 my (%params) = @_;
28              
29 1 50       6 my $hostname = $OSNAME eq 'MSWin32' ?
30             _getHostnameWindows() :
31             _getHostnameUnix() ;
32              
33 1 50       12 if ($params{short}) {
34 0         0 $hostname =~ s/\..*$//;
35             }
36              
37 1         3 return $hostname;
38             }
39              
40             sub _getHostnameUnix {
41 1     1   9 Sys::Hostname->require();
42 1         823 return Sys::Hostname::hostname();
43             }
44              
45             sub _getHostnameWindows {
46 0     0     my $getComputerName = Win32::API->new(
47             "kernel32", "GetComputerNameExW", ["I", "P", "P"], "N"
48             );
49 0           my $buffer = "\x00" x 1024;
50 0           my $n = 1024; #pack ("c4", 160,0,0,0);
51              
52 0           $getComputerName->Call(3, $buffer, $n);
53              
54             # convert from UTF16 to UTF8
55 0           my $hostname = substr(decode("UCS-2le", $buffer), 0, ord $n);
56              
57 0   0       return $hostname || $ENV{COMPUTERNAME};
58             }
59              
60             1;
61             __END__