File Coverage

blib/lib/Net/Checkpoint/Management/v1/Role/ObjectMethods.pm
Criterion Covered Total %
statement 17 67 25.3
branch 0 12 0.0
condition 0 12 0.0
subroutine 6 12 50.0
pod n/a
total 23 103 22.3


line stmt bran cond sub pod time code
1             package Net::Checkpoint::Management::v1::Role::ObjectMethods;
2             $Net::Checkpoint::Management::v1::Role::ObjectMethods::VERSION = '0.002000';
3             # ABSTRACT: Role for Checkpoint Management API version 1.x method generation
4              
5 1     1   24 use 5.024;
  1         5  
6 1     1   14 use feature 'signatures';
  1         2  
  1         99  
7 1     1   488 use MooX::Role::Parameterized;
  1         4256  
  1         64  
8 1     1   8 use Carp::Clan qw(^Net::Checkpoint::Management::v1);
  1         3  
  1         7  
9 1     1   579 use Moo::Role; # last for cleanup
  1         8860  
  1         6  
10              
11 1     1   635 no warnings "experimental::signatures";
  1         3  
  1         1073  
12              
13             requires qw( _create _list _get _update _delete );
14              
15              
16              
17              
18              
19              
20              
21              
22             role {
23             my $params = shift;
24             my $mop = shift;
25              
26             if (exists $params->{singular} && defined $params->{singular}) {
27 0     0     $mop->method('create_' . $params->{singular} => sub ($self, $object_data) {
  0            
  0            
  0            
28             return $self->_create(join('/',
29             '/web_api',
30             'v' . $self->api_version,
31             $params->{create}
32 0           ), $object_data);
33             })
34             if exists $params->{create} && defined $params->{create};
35              
36 0     0     $mop->method('get_' . $params->{singular} => sub ($self, $query_params = {}) {
  0            
  0            
  0            
37             return $self->_get(join('/',
38             '/web_api',
39             'v' . $self->api_version,
40             $params->{get}
41 0           ), $query_params);
42             })
43             if exists $params->{get} && defined $params->{get};
44              
45 0     0     $mop->method('update_' . $params->{singular} => sub ($self, $object, $object_data) {
  0            
  0            
  0            
  0            
46 0           my $updated_data = { %$object, %$object_data };
47 0 0 0       if (exists $params->{id_keys} && ref $params->{id_keys} eq 'ARRAY') {
48             # ensure that only a single key is passed to the update call
49             # the order of keys is the priority
50 0           my @id_keys = $params->{id_keys}->@*;
51 0           while (my $key = shift @id_keys) {
52             last
53             if exists $updated_data->{$key}
54 0 0 0       && defined $updated_data->{$key};
55             }
56             delete $updated_data->{$_}
57 0           for @id_keys;
58             }
59              
60             return $self->_update(join('/',
61             '/web_api',
62             'v' . $self->api_version,
63             $params->{update}
64 0           ), $updated_data);
65             })
66             if exists $params->{update} && defined $params->{update};
67              
68 0     0     $mop->method('delete_' . $params->{singular} => sub ($self, $object) {
  0            
  0            
  0            
69             return $self->_delete(join('/',
70             '/web_api',
71             'v' . $self->api_version,
72             $params->{delete}
73 0           ), $object);
74             })
75             if exists $params->{delete} && defined $params->{delete};
76              
77 0     0     $mop->method('find_' . $params->{singular} => sub ($self, $search_params = {}, $query_params = {}) {
  0            
  0            
  0            
  0            
78 0           my $listname = 'list_' . $params->{object};
79 0           my $list_key = $params->{list_key};
80 0           for my $object ($self->$listname({ 'details-level' => 'full', %$query_params })->{$list_key}->@*) {
81 0           my $identical = 0;
82 0           for my $key (keys $search_params->%*) {
83 0 0         if ( ref $search_params->{$key} eq 'Regexp') {
84 0 0 0       if ( exists $object->{$key}
85             && $object->{$key} =~ $search_params->{$key}) {
86 0           $identical++;
87             }
88             }
89             else {
90 0 0 0       if ( exists $object->{$key}
91             && $object->{$key} eq $search_params->{$key}) {
92 0           $identical++;
93             }
94             }
95             }
96 0 0         if ($identical == scalar keys $search_params->%*) {
97 0           return $object;
98             }
99             }
100 0           croak "object not found";
101             });
102             }
103              
104             if (exists $params->{object} && defined $params->{object}) {
105 0     0     $mop->method('list_' . $params->{object} => sub ($self, $query_params = {}) {
  0            
  0            
  0            
106             return $self->_list(join('/',
107             '/web_api',
108             'v' . $self->api_version,
109             $params->{list}
110 0           ), $params->{list_key}, $query_params);
111             });
112             }
113             };
114              
115             1;
116              
117             __END__
118              
119             =pod
120              
121             =encoding UTF-8
122              
123             =head1 NAME
124              
125             Net::Checkpoint::Management::v1::Role::ObjectMethods - Role for Checkpoint Management API version 1.x method generation
126              
127             =head1 VERSION
128              
129             version 0.002000
130              
131             =head1 SYNOPSIS
132              
133             package Net::Checkpoint::Management::v1;
134             use Moo;
135             use Net::Checkpoint::Management::v1::Role::ObjectMethods;
136              
137             Net::Checkpoint::Management::v1::Role::ObjectMethods->apply([
138             {
139             object => 'packages',
140             singular => 'package',
141             create => 'add-package',
142             list => 'show-packages',
143             get => 'show-package',
144             update => 'set-package',
145             delete => 'delete-package',
146             list_key => 'packages',
147             id_keys => [qw( uid name )],
148             },
149             {
150             object => 'accessrules',
151             singular => 'accessrule',
152             create => 'add-access-rule',
153             list => 'show-access-rulebase',
154             get => 'show-access-rule',
155             update => 'set-access-rule',
156             delete => 'delete-access-rule',
157             list_key => 'rulebase',
158             id_keys => ['uid', 'name', 'rule-number'],
159             },
160             ]);
161              
162             1;
163              
164             =head1 DESCRIPTION
165              
166             This role adds methods for the commands of a specific object.
167              
168             =head1 METHODS
169              
170             =head2 create_$singular
171              
172             Takes a hashref of attributes.
173              
174             Returns the created object as hashref.
175              
176             Throws an exception on error.
177              
178             =head2 list_$object
179              
180             Takes optional query parameters.
181              
182             Returns a hashref similar to the Checkpoint Management API but without the
183             'from' and 'to' keys.
184              
185             Throws an exception on error.
186              
187             As the API only allows fetching 500 objects at a time it works around that by
188             making multiple API calls.
189              
190             =head2 get_$singular
191              
192             Takes an object id and optional query parameters.
193              
194             Returns the object as hashref.
195              
196             Throws an exception on error.
197              
198             =head2 update_$singular
199              
200             Takes an object and a hashref of attributes.
201              
202             Returns the updated object as hashref.
203              
204             Throws an exception on error.
205              
206             =head2 delete_$singular
207              
208             Takes a hashref of attributes uniquely identifying the object.
209             For most objects the uid is sufficient, accessrule requires the layer uid too.
210              
211             Returns true on success.
212              
213             Throws an exception on error.
214              
215             =head2 find_$singular
216              
217             Takes search and optional query parameters.
218              
219             Returns the object as hashref on success.
220              
221             Throws an exception on error.
222              
223             As there is no API for searching by all attributes this method emulates this
224             by fetching all objects using the L</list_$object> method and performing the
225             search on the client.
226              
227             =head1 AUTHOR
228              
229             Alexander Hartmaier <abraxxa@cpan.org>
230              
231             =head1 COPYRIGHT AND LICENSE
232              
233             This software is copyright (c) 2022 by Alexander Hartmaier.
234              
235             This is free software; you can redistribute it and/or modify it under
236             the same terms as the Perl 5 programming language system itself.
237              
238             =cut