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   50711 use strict;
  5         15  
  5         191  
4 5     5   32 use warnings;
  5         18  
  5         142  
5              
6 5     5   56 use Moo::Role;
  5         14  
  5         32  
7              
8 5     5   1952 use OpenStack::MetaAPI::Helpers::DataAsYaml;
  5         14  
  5         4351  
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 53 my ($self, $route) = @_;
27              
28 20 50       73 $route = '/' . $route unless $route =~ m{^/};
29              
30 20         401 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 202 my ($self, $method, $route, $args) = @_;
43              
44 20 50       52 die unless defined $method;
45 20 50       52 die unless defined $route;
46 20 50       58 die unless ref $args eq 'ARRAY';
47              
48 20 50       133 return unless @$args % 2 == 0;
49              
50 20         59 my %filters = @$args;
51              
52 20         85 $method =~ s{^/+}{};
53              
54 20         88 my $spec = $self->can($method)->($self, $route);
55              
56             return
57             unless ref $spec eq 'HASH'
58             && ref $spec->{request}
59 20 50 33     324 && ref $spec->{request}->{query};
      33        
60              
61 20         45 my %valid_filters = map { $_ => 1 } sort keys %{$spec->{request}->{query}};
  87         255  
  20         109  
62              
63 20         60 my $use_filters = {};
64              
65 20         64 foreach my $filter (sort keys %filters) {
66 17 100       55 next unless defined $valid_filters{$filter};
67             ### ... can use type & co ...
68 2         8 $use_filters->{$filter} = $filters{$filter};
69             }
70              
71 20 100       103 return unless scalar keys %$use_filters;
72 2         9 return $use_filters;
73             }
74              
75             ## hook all methods to our object
76             sub setup_api_methods_for_service {
77 8     8 0 7817 my ($self, $service) = @_;
78              
79 8         150 my $specs = $self->specs;
80 8         63 foreach my $method (sort keys %$specs) {
81 32         55 foreach my $route (sort keys %{$specs->{$method}}) {
  32         105  
82 30         64 my $rule = $specs->{$method}->{$route};
83 30 50 33     128 next unless ref $rule && ref $rule->{perl_api};
84 30         51 my $perl_api = $rule->{perl_api};
85              
86 30     0   89 my $code = sub { };
87              
88 30         612 my $from_txt =
89             "from spec " . (ref $self->specs) . " for route $route";
90              
91             my $method_name = $perl_api->{method}
92 30 50       287 or die "method is missing $from_txt";
93 30 50       72 my $type = $perl_api->{type} or die "type is missing $from_txt";
94 30 100       84 if ($type eq 'getfromid') {
    50          
95 9 50       27 my $token = $perl_api->{uid} or die "uid is missing $from_txt";
96              
97             $code = sub {
98 8     8   70 my ($self, $uid) = @_;
99              
100 8         24 my $r = $route;
101 8         99 $r =~ s[\Q$token\E][$uid]g;
102              
103 8         46 return $self->_get_from_id_spec($r, $uid);
104 9         58 };
105             } elsif ($type eq 'listable') {
106             my $listable_key = $perl_api->{listable_key}
107 21 50       51 or die "listable_key is missing $from_txt";
108             $code = sub {
109 20     20   57 my ($self, @args) = @_;
110 20         90 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         131 $service->setup_method($method_name, $code);
117             }
118             }
119              
120 8         28 return;
121             }
122              
123             1;
124              
125             __END__