File Coverage

blib/lib/FusionInventory/Agent/Tools/MacOS.pm
Criterion Covered Total %
statement 38 38 100.0
branch 10 12 83.3
condition 3 5 60.0
subroutine 7 7 100.0
pod 1 1 100.0
total 59 63 93.6


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::Tools::MacOS;
2              
3 19     19   5710695 use strict;
  19         23  
  19         487  
4 19     19   70 use warnings;
  19         25  
  19         467  
5 19     19   60 use base 'Exporter';
  19         64  
  19         1468  
6              
7 19     19   538 use English qw(-no_match_vars);
  19         2564  
  19         140  
8 19     19   7246 use Memoize;
  19         3625  
  19         705  
9              
10 19     19   790 use FusionInventory::Agent::Tools;
  19         28  
  19         12023  
11              
12             our @EXPORT = qw(
13             getSystemProfilerInfos
14             getIODevices
15             );
16              
17             memoize('getSystemProfilerInfos');
18              
19             sub getSystemProfilerInfos {
20             my (%params) = @_;
21              
22             my $command = $params{type} ?
23             "/usr/sbin/system_profiler $params{type}" : "/usr/sbin/system_profiler";
24             my $handle = getFileHandle(command => $command, %params);
25              
26             my $info = {};
27              
28             my @parents = (
29             [ $info, -1 ]
30             );
31             while (my $line = <$handle>) {
32             chomp $line;
33              
34             next unless $line =~ /^(\s*)(\S[^:]*):(?: (.*\S))?/;
35             my $level = defined $1 ? length($1) : 0;
36             my $key = $2;
37             my $value = $3;
38              
39             my $parent = $parents[-1];
40             my $parent_level = $parent->[1];
41             my $parent_node = $parent->[0];
42              
43             if (defined $value) {
44             # check indentation level against parent node
45             if ($level <= $parent_level) {
46              
47             if (keys %$parent_node == 0) {
48             # discard just created node, and fix its parent
49             my $parent_key = $parent->[2];
50             $parents[-2]->[0]->{$parent_key} = undef;
51             }
52              
53             # unstack nodes until a suitable parent is found
54             while ($level <= $parents[-1]->[1]) {
55             pop @parents;
56             }
57             $parent_node = $parents[-1]->[0];
58             }
59              
60             # add the value to the current node
61             $parent_node->{$key} = $value;
62             } else {
63             # compare level with parent
64             if ($level > $parent_level) {
65             # down the tree: no change
66             } elsif ($level < $parent_level) {
67             # up the tree: unstack nodes until a suitable parent is found
68             while ($level <= $parents[-1]->[1]) {
69             pop @parents;
70             }
71             } else {
72             # same level: unstack last node
73             pop @parents;
74             }
75              
76             # create a new node, and push it to the stack
77             my $parent_node = $parents[-1]->[0];
78              
79             my $i;
80             my $keyL = $key;
81             while (defined($parent_node->{$key})) {
82             $key = $keyL . '_' . $i++;
83             }
84              
85             $parent_node->{$key} = {};
86             push (@parents, [ $parent_node->{$key}, $level, $key ]);
87             }
88             }
89             close $handle;
90              
91             return $info;
92             }
93              
94             sub getIODevices {
95 5     5 1 88331 my (%params) = @_;
96              
97             # passing expected class to the command ensure only instance of this class
98             # are present in the output, reducing the size of the content to be parsed,
99             # but still requires some manual filtering to avoid subclasses instances
100 5 50       21 my $command = $params{class} ? "ioreg -c $params{class}" : "ioreg -l";
101 5   50     12 my $filter = $params{class} || '[^,]+';
102              
103 5         21 my $handle = getFileHandle(command => $command, %params);
104 5 50       16 return unless $handle;
105              
106 5         6 my @devices;
107             my $device;
108              
109              
110 5         173 while (my $line = <$handle>) {
111 3929 100       6349 if ($line =~ /
112             # new device block
113 23         44 $device = {};
114 23         46 next;
115             }
116              
117 3906 100       7139 next unless $device;
118              
119 637 100       826 if ($line =~ /\| }/) {
120             # end of device block
121 23         24 push @devices, $device;
122 23         20 undef $device;
123 23         42 next;
124             }
125              
126 614 100       1641 if ($line =~ /"([^"]+)" \s = \s ?/x) {
127             # string or numeric property
128 525   66     1234 $device->{$1} = $2 || $3;
129 525         1046 next;
130             }
131              
132             }
133 5         41 close $handle;
134              
135 5         31 return @devices;
136             }
137              
138             1;
139             __END__