File Coverage

blib/lib/OpenStack/MetaAPI/Roles/GetFromId.pm
Criterion Covered Total %
statement 18 30 60.0
branch 5 20 25.0
condition 1 6 16.6
subroutine 4 5 80.0
pod n/a
total 28 61 45.9


line stmt bran cond sub pod time code
1             package OpenStack::MetaAPI::Roles::GetFromId;
2              
3 4     4   1794 use strict;
  4         7  
  4         105  
4 4     4   18 use warnings;
  4         8  
  4         85  
5              
6 4     4   17 use Moo::Role;
  4         8  
  4         19  
7              
8             ### FIXME to delete once unused, should prefer the other flavor
9             sub _get_from_id {
10 0     0   0 my ($self, $route, $id) = @_;
11              
12 0 0       0 die "route must be defined when using get_from_id" unless defined $route;
13 0 0       0 die "invalid route '$route' - must starts with /" unless $route =~ m{^/};
14 0 0       0 die "Undefined 'id' for route '$route'" unless defined $id;
15              
16 0 0       0 $route .= '/' unless $route =~ m{/$};
17              
18 0         0 my $uri = $self->root_uri($route . $id);
19 0         0 my $answer = $self->get($uri);
20              
21 0 0 0     0 if (ref $answer eq 'HASH' && scalar keys %$answer == 1) {
22 0         0 my ($mainkey) = keys %$answer;
23 0         0 return $answer->{$mainkey};
24             }
25              
26 0         0 return $answer;
27             }
28              
29             sub _get_from_id_spec {
30 8     8   22 my ($self, $route, $id) = @_;
31              
32 8 50       22 die "route must be defined when using get_from_id" unless defined $route;
33 8 50       29 die "invalid route '$route' - must starts with /" unless $route =~ m{^/};
34 8 50       20 die "Undefined 'id' for route '$route'" unless defined $id;
35              
36 8 50       47 $route .= '/' unless $route =~ m{/$};
37              
38             #my $uri = $self->root_uri( $route );
39              
40 8         170 my $answer = $self->get($route);
41              
42 8 50 33     16070 if (ref $answer eq 'HASH' && scalar keys %$answer == 1) {
43 8         25 my ($mainkey) = keys %$answer;
44 8         57 return $answer->{$mainkey};
45             }
46              
47 0           return $answer;
48             }
49              
50             1;
51              
52             __END__