File Coverage

lib/Rex/Inventory/Hal/Object.pm
Criterion Covered Total %
statement 28 60 46.6
branch 2 12 16.6
condition 0 3 0.0
subroutine 7 13 53.8
pod 0 5 0.0
total 37 93 39.7


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring
3             #
4              
5             package Rex::Inventory::Hal::Object;
6              
7 1     1   14 use v5.12.5;
  1         4  
8 1     1   5 use warnings;
  1         13  
  1         148  
9              
10             our $VERSION = '1.14.2.3'; # TRIAL VERSION
11              
12             sub new {
13 0     0 0 0 my $that = shift;
14 0   0     0 my $proto = ref($that) || $that;
15 0         0 my $self = {@_};
16              
17 0         0 bless( $self, $proto );
18              
19 0         0 return $self;
20             }
21              
22             sub has {
23              
24 3     3 0 11 my ( $class, $keys ) = @_;
25 3         6 for my $k ( @{$keys} ) {
  3         11  
  0            
26 13         26 my $key = $k->{key};
27 13         20 my $accessor = $k->{accessor};
28 13         18 my $overwrite = $k->{overwrite};
29              
30 1     1   8 no strict 'refs';
  1         3  
  1         192  
31 13 100       26 if ( !$overwrite ) {
32 12         60 *{"${class}::get_$accessor"} = sub {
33 0     0   0 my ($self) = @_;
        0      
34 0 0       0 if ( $k->{"parent"} ) {
35 0         0 return $self->parent()->get($key);
36             }
37             else {
38 0 0       0 if ( ref($key) eq "ARRAY" ) {
39 0         0 for my $_k ( @{$key} ) {
  0         0  
40 0 0       0 if ( my $ret = $self->get($_k) ) {
41 0         0 return $ret;
42             }
43              
44 0         0 return "";
45             }
46             }
47             else {
48 0         0 return $self->get($key);
49             }
50             }
51 12         43 };
52              
53             }
54 13         22 push( @{"${class}::items"}, $k );
  13         45  
55              
56 1     1   9 use strict;
  1         1  
  1         233  
57             }
58              
59             }
60              
61             # returns the parent of the current object
62             sub parent {
63              
64 0     0 0   my ($self) = @_;
65 0           return $self->{"hal"}->get_object_by_udi( $self->{'info.parent'} );
66              
67             }
68              
69             sub get {
70              
71 0     0 0   my ( $self, $key ) = @_;
72              
73 0 0         if ( ref( $self->{$key} ) eq "ARRAY" ) {
74 0           return @{ $self->{$key} };
  0            
75             }
76              
77             return exists $self->{$key}
78 0 0         ? $self->{$key}
79             : "";
80              
81             }
82              
83             sub get_all {
84              
85 0     0 0   my ($self) = @_;
86              
87 0           my $r = ref($self);
88              
89 1     1   15 no strict 'refs';
  1         3  
  1         64  
90 0           my @items = @{"${r}::items"};
  0            
91 1     1   13 use strict;
  1         3  
  1         101  
92              
93 0           my $ret;
94 0           for my $itm (@items) {
95 0           my $f = "get_" . $itm->{"accessor"};
96 0           $ret->{ $itm->{"accessor"} } = $self->$f();
97             }
98              
99 0           return $ret;
100             }
101              
102             1;