File Coverage

lib/Rex/Inventory/Hal.pm
Criterion Covered Total %
statement 23 112 20.5
branch 0 28 0.0
condition 0 21 0.0
subroutine 8 17 47.0
pod 0 7 0.0
total 31 185 16.7


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             package Rex::Inventory::Hal;
6              
7 1     1   15 use v5.12.5;
  1         4  
8 1     1   5 use warnings;
  1         2  
  1         42  
9              
10 1     1   6 use Rex::Inventory::Hal::Object;
  1         2  
  1         13  
11 1     1   36 use Rex::Commands::Run;
  1         3  
  1         7  
12 1     1   7 use Rex::Helper::Run;
  1         7  
  1         65  
13 1     1   6 use Rex::Commands::Gather;
  1         2  
  1         7  
14 1     1   6 use Rex::Logger;
  1         3  
  1         17  
15              
16             our $VERSION = '1.14.3'; # VERSION
17              
18 1     1   72 use Data::Dumper;
  1         4  
  1         1291  
19              
20             sub new {
21 0     0 0   my $that = shift;
22 0   0       my $proto = ref($that) || $that;
23 0           my $self = {@_};
24              
25 0           bless( $self, $proto );
26              
27 0           $self->_read_lshal();
28              
29 0           return $self;
30             }
31              
32             # get devices of $category
33             # like net or storage
34             sub get_devices_of {
35              
36 0     0 0   my ( $self, $cat, $rex_class ) = @_;
37 0           my @ret;
38              
39 0           for my $dev ( keys %{ $self->{'__hal'}->{$cat} } ) {
  0            
40 0           push( @ret, $self->get_object_by_cat_and_udi( $cat, $dev, $rex_class ) );
41             }
42              
43 0           return @ret;
44             }
45              
46             # get network devices
47             sub get_network_devices {
48              
49 0     0 0   my ($self) = @_;
50 0           return $self->get_devices_of('net');
51              
52             }
53              
54             # get storage devices
55             sub get_storage_devices {
56              
57 0     0 0   my ($self) = @_;
58 0           my $os = get_operating_system();
59              
60 0 0         if ( $os =~ m/BSD/ ) {
61             return
62 0   0       grep { !$_->is_cdrom && !$_->is_volume && !$_->is_floppy }
  0            
63             $self->get_devices_of( 'block', 'storage' );
64             }
65             else {
66             # default linux
67             return
68 0   0       grep { !$_->is_cdrom && !$_->is_floppy } $self->get_devices_of('storage');
  0            
69             }
70              
71             }
72              
73             # get storage volumes
74             sub get_storage_volumes {
75              
76 0     0 0   my ($self) = @_;
77              
78 0           my $os = get_operating_system();
79              
80 0 0         if ( $os =~ m/BSD/ ) {
81             return
82 0 0 0       grep { !$_->is_cdrom && $_->is_volume && !$_->is_floppy }
  0            
83             $self->get_devices_of( 'block', 'volume' );
84             }
85             else {
86             # default linux
87 0           return $self->get_devices_of('volume');
88             }
89              
90             }
91              
92             # get a hal object from category and udi
93             sub get_object_by_cat_and_udi {
94 0     0 0   my ( $self, $cat, $udi, $rex_class ) = @_;
95              
96 0   0       $rex_class ||= $cat;
97              
98 0           my $class_name = "Rex::Inventory::Hal::Object::\u$rex_class";
99 0           eval "use $class_name";
100 0 0         if ($@) {
101 0           Rex::Logger::debug(
102             "This Hal Object isn't supported yet. Falling back to Base Object.");
103 0           $class_name = "Rex::Inventory::Hal::Object";
104             }
105              
106 0           return $class_name->new( %{ $self->{'__hal'}->{$cat}->{$udi} },
  0            
107             hal => $self );
108             }
109              
110             # get object by udi
111             sub get_object_by_udi {
112 0     0 0   my ( $self, $udi ) = @_;
113              
114 0           for my $cat ( keys %{ $self->{'__hal'} } ) {
  0            
115 0           for my $dev ( keys %{ $self->{'__hal'}->{$cat} } ) {
  0            
116 0 0         if ( $dev eq $udi ) {
117 0           return $self->get_object_by_cat_and_udi( $cat, $dev );
118             }
119             }
120             }
121             }
122              
123             # private method to read lshal output
124             # you don't see that...
125             sub _read_lshal {
126              
127 0     0     my ($self) = @_;
128              
129 0 0         unless ( can_run "lshal" ) {
130 0           Rex::Logger::info("No lshal available");
131 0           die;
132             }
133              
134 0           my @lines = i_run "lshal", fail_ok => 1;
135 0           my %devices;
136             my %tmp_devices;
137              
138 0           my $in_dev = 0;
139 0           my %data;
140             my $dev_name;
141              
142 0           for my $l (@lines) {
143 0           chomp $l;
144              
145 0 0         if ( $l =~ m/^udi = '(.*?)'/ ) {
146 0           $in_dev = 1;
147 0           $dev_name = $1;
148             }
149              
150 0 0         if ( $l =~ m/^$/ ) {
151 0           $in_dev = 0;
152 0 0         unless ($dev_name) {
153 0           %data = ();
154 0           next;
155             }
156 0           $tmp_devices{$dev_name} = {%data};
157 0           %data = ();
158             }
159              
160 0 0         if ($in_dev) {
161 0           my ( $key, $val ) = split( / = /, $l, 2 );
162 0           $key =~ s/^\s+//;
163 0           $key =~ s/^'|'$//g;
164 0           $val =~ s/\(.*?\)$//;
165 0           $val =~ s/^\s+//;
166 0           $val =~ s/\s+$//;
167 0           $val =~ s/^'|'$//g;
168 0           $data{$key} = $self->_parse_hal_string($val);
169             }
170              
171             }
172              
173 0           for my $dev ( keys %tmp_devices ) {
174              
175             my $s_key = $tmp_devices{$dev}->{"info.subsystem"}
176 0   0       || $tmp_devices{$dev}->{"linux.subsystem"};
177 0   0       $s_key ||= $tmp_devices{$dev}->{"info.category"};
178              
179 0 0         if ( !$s_key ) {
180              
181             #print Dumper($tmp_devices{$dev});
182 0           next;
183             }
184              
185 0 0         if ( $s_key =~ m/\./ ) {
186 0           ($s_key) = split( /\./, $s_key );
187             }
188              
189 0 0         if ( !exists $devices{$s_key} ) {
190 0           $devices{$s_key} = {};
191             }
192              
193 0           $devices{$s_key}->{$dev} = $tmp_devices{$dev};
194              
195             }
196              
197 0           $self->{'__hal'} = \%devices;
198              
199             }
200              
201             sub _parse_hal_string {
202              
203 0     0     my ( $self, $line ) = @_;
204              
205 0 0         if ( $line =~ m/^\{.*\}$/ ) {
206 0           $line =~ s/^\{/[/;
207 0           $line =~ s/\}$/]/;
208              
209 0           return eval $line;
210             }
211              
212 0           return $line;
213              
214             }
215              
216             1;