File Coverage

blib/lib/FusionInventory/Agent/Tools/MacOS.pm
Criterion Covered Total %
statement 18 38 47.3
branch 0 12 0.0
condition 0 5 0.0
subroutine 6 7 85.7
pod 1 1 100.0
total 25 63 39.6


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::Tools::MacOS;
2              
3 12     12   6590350 use strict;
  12         30  
  12         477  
4 12     12   60 use warnings;
  12         17  
  12         447  
5 12     12   62 use base 'Exporter';
  12         108  
  12         1217  
6              
7 12     12   58 use English qw(-no_match_vars);
  12         16  
  12         94  
8 12     12   5838 use Memoize;
  12         2283  
  12         674  
9              
10 12     12   539 use FusionInventory::Agent::Tools;
  12         15  
  12         8953  
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 0     0 1   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 0 0         my $command = $params{class} ? "ioreg -c $params{class}" : "ioreg -l";
101 0   0       my $filter = $params{class} || '[^,]+';
102              
103 0           my $handle = getFileHandle(command => $command, %params);
104 0 0         return unless $handle;
105              
106 0           my @devices;
107             my $device;
108              
109              
110 0           while (my $line = <$handle>) {
111 0 0         if ($line =~ /
112             # new device block
113 0           $device = {};
114 0           next;
115             }
116              
117 0 0         next unless $device;
118              
119 0 0         if ($line =~ /\| }/) {
120             # end of device block
121 0           push @devices, $device;
122 0           undef $device;
123 0           next;
124             }
125              
126 0 0         if ($line =~ /"([^"]+)" \s = \s ?/x) {
127             # string or numeric property
128 0   0       $device->{$1} = $2 || $3;
129 0           next;
130             }
131              
132             }
133 0           close $handle;
134              
135 0           return @devices;
136             }
137              
138             1;
139             __END__