File Coverage

blib/lib/OpenStack/MetaAPI/API/Specs/Roles/Service.pm
Criterion Covered Total %
statement 58 61 95.0
branch 18 30 60.0
condition 3 9 33.3
subroutine 9 12 75.0
pod 0 5 0.0
total 88 117 75.2


line stmt bran cond sub pod time code
1             package OpenStack::MetaAPI::API::Specs::Roles::Service;
2              
3 5     5   41429 use strict;
  5         11  
  5         151  
4 5     5   25 use warnings;
  5         11  
  5         116  
5              
6 5     5   38 use Moo::Role;
  5         11  
  5         29  
7              
8 5     5   1567 use OpenStack::MetaAPI::Helpers::DataAsYaml;
  5         11  
  5         3649  
9              
10             has 'specs' => (
11             is => 'ro',
12             lazy => 1,
13             default => sub {
14             my ($self) = @_;
15             my $specs =
16             OpenStack::MetaAPI::Helpers::DataAsYaml::LoadDataFrom(ref $self)
17             // {};
18              
19             # populate missing keys
20             $specs->{$_} //= {} for qw/get post put delete/;
21              
22             return $specs;
23             });
24              
25             sub get {
26 20     20 0 45 my ($self, $route) = @_;
27              
28 20 50       61 $route = '/' . $route unless $route =~ m{^/};
29              
30 20         322 return $self->specs()->{get}->{$route};
31             }
32              
33             sub put {
34 0     0 0 0 die "must be implemented";
35             }
36              
37             sub post {
38 0     0 0 0 die "must be implemented";
39             }
40              
41             sub query_filters_for {
42 20     20 0 179 my ($self, $method, $route, $args) = @_;
43              
44 20 50       44 die unless defined $method;
45 20 50       43 die unless defined $route;
46 20 50       59 die unless ref $args eq 'ARRAY';
47              
48 20 50       57 return unless @$args % 2 == 0;
49              
50 20         50 my %filters = @$args;
51              
52 20         70 $method =~ s{^/+}{};
53              
54 20         97 my $spec = $self->can($method)->($self, $route);
55              
56             return
57             unless ref $spec eq 'HASH'
58             && ref $spec->{request}
59 20 50 33     288 && ref $spec->{request}->{query};
      33        
60              
61 20         40 my %valid_filters = map { $_ => 1 } sort keys %{$spec->{request}->{query}};
  87         151  
  20         108  
62              
63 20         47 my $use_filters = {};
64              
65 20         74 foreach my $filter (sort keys %filters) {
66 17 100       45 next unless defined $valid_filters{$filter};
67             ### ... can use type & co ...
68 2         5 $use_filters->{$filter} = $filters{$filter};
69             }
70              
71 20 100       102 return unless scalar keys %$use_filters;
72 2         8 return $use_filters;
73             }
74              
75             ## hook all methods to our object
76             sub setup_api_methods_for_service {
77 8     8 0 7014 my ($self, $service) = @_;
78              
79 8         142 my $specs = $self->specs;
80 8         50 foreach my $method (sort keys %$specs) {
81 32         52 foreach my $route (sort keys %{$specs->{$method}}) {
  32         87  
82 30         55 my $rule = $specs->{$method}->{$route};
83 30 50 33     136 next unless ref $rule && ref $rule->{perl_api};
84 30         44 my $perl_api = $rule->{perl_api};
85              
86 30     0   92 my $code = sub { };
87              
88 30         533 my $from_txt =
89             "from spec " . (ref $self->specs) . " for route $route";
90              
91             my $method_name = $perl_api->{method}
92 30 50       293 or die "method is missing $from_txt";
93 30 50       70 my $type = $perl_api->{type} or die "type is missing $from_txt";
94 30 100       79 if ($type eq 'getfromid') {
    50          
95 9 50       40 my $token = $perl_api->{uid} or die "uid is missing $from_txt";
96              
97             $code = sub {
98 8     8   50 my ($self, $uid) = @_;
99              
100 8         21 my $r = $route;
101 8         86 $r =~ s[\Q$token\E][$uid]g;
102              
103 8         38 return $self->_get_from_id_spec($r, $uid);
104 9         65 };
105             } elsif ($type eq 'listable') {
106             my $listable_key = $perl_api->{listable_key}
107 21 50       49 or die "listable_key is missing $from_txt";
108             $code = sub {
109 20     20   60 my ($self, @args) = @_;
110 20         92 return $self->_list([$route, $listable_key], \@args);
111 21         99 };
112             } else {
113 0         0 die "Unknown type '$type' $from_txt";
114             }
115              
116 30         123 $service->setup_method($method_name, $code);
117             }
118             }
119              
120 8         26 return;
121             }
122              
123             1;
124              
125             __END__