File Coverage

blib/lib/VMware/vCloudDirector2/Object.pm
Criterion Covered Total %
statement 60 199 30.1
branch 3 102 2.9
condition 0 24 0.0
subroutine 35 57 61.4
pod n/a
total 98 382 25.6


line stmt bran cond sub pod time code
1             package VMware::vCloudDirector2::Object;
2              
3             # ABSTRACT: Module to contain an object!
4              
5 4     4   29 use strict;
  4         9  
  4         135  
6 4     4   25 use warnings;
  4         10  
  4         217  
7              
8             our $VERSION = '0.107'; # VERSION
9             our $AUTHORITY = 'cpan:NIGELM'; # AUTHORITY
10              
11 4     4   25 use Moose;
  4         7  
  4         29  
12 4     4   27816 use Method::Signatures;
  4         9  
  4         38  
13 4     4   2044 use MooseX::Types::URI qw(Uri);
  4         11  
  4         66  
14 4     4   10143 use Const::Fast;
  4         4648  
  4         27  
15 4     4   309 use Ref::Util qw(is_plain_hashref is_plain_arrayref);
  4         9  
  4         196  
16 4     4   1886 use VMware::vCloudDirector2::Link;
  4         17  
  4         174  
17 4     4   39 use VMware::vCloudDirector2::Error;
  4         8  
  4         1912  
18              
19             # ------------------------------------------------------------------------
20              
21              
22             has api => (
23             is => 'ro',
24             isa => 'VMware::vCloudDirector2::API',
25             required => 1,
26             weak_ref => 1,
27             documentation => 'API we use'
28             );
29              
30             has mime_type => ( is => 'ro', isa => 'Str', required => 1 );
31             has href => ( is => 'ro', isa => Uri, required => 1, coerce => 1 );
32             has type => ( is => 'ro', isa => 'Str', required => 1 );
33             has uuid => ( is => 'ro', isa => 'Str', builder => '_build_uuid', lazy => 1 );
34             has name =>
35             ( is => 'ro', isa => 'Str', predicate => 'has_name', lazy => 1, builder => '_build_name' );
36             has id => ( is => 'ro', isa => 'Str', predicate => 'has_id', lazy => 1, builder => '_build_id' );
37              
38             has _partial_object => ( is => 'rw', isa => 'Bool', default => 0 );
39             has is_json => ( is => 'rw', isa => 'Bool', default => 0 );
40              
41             # ------------------------------------------------------------------------
42             around BUILDARGS => sub {
43             my ( $orig, $class, $first, @rest ) = @_;
44              
45             my $params = is_plain_hashref($first) ? $first : { $first, @rest };
46             if ( $params->{hash} ) {
47             my $hash = $params->{hash};
48              
49             # copy elements into object attributes
50             foreach (qw[href name id]) {
51             $params->{$_} = $hash->{$_} if ( exists( $hash->{$_} ) and defined( $hash->{$_} ) );
52             }
53              
54             # set the object type and mime_type
55             if ( exists( $hash->{type} ) ) {
56             $params->{mime_type} = $hash->{type};
57             $params->{type} = $1
58             if ( $hash->{type} =~ m!^application/vnd\..*\.(\w+)\+(json|xml)$! );
59             $params->{is_json} = ( $2 eq 'json' ) ? 1 : 0;
60             }
61              
62             # if this has a links section it is a complete object, otherwise its partial
63             if ( exists( $hash->{link} ) ) {
64             $params->{_partial_object} = 0;
65             const $params->{hash} => $hash; # force hash read-only to stop people playing
66             }
67             else {
68             $params->{_partial_object} = 1;
69             delete( $params->{hash} ); # do not populate the hash in the partial object
70             }
71             }
72             else {
73             # no hash so this must be a partial object
74             $params->{_partial_object} = 1;
75             }
76             return $class->$orig($params);
77             };
78              
79             # ------------------------------------------------------------------------
80             has hash => (
81             is => 'ro',
82             traits => ['Hash'],
83             isa => 'HashRef',
84             builder => '_build_hash',
85             clearer => '_clear_hash',
86             lazy => 1,
87             handles => { get_hash_item => 'get', exists_hash_item => 'exists', }
88             );
89              
90 4 50   4   3153 method _build_hash () {
  1     1   3  
  1         4  
91              
92             # fetch object content
93 1         36 const my $hash => $self->api->GET_hash( $self->href );
94 1 0       2181 $self->api->_debug(
    50          
95             sprintf(
96             'Object: %s a [%s]',
97             ( $self->_partial_object ? 'Inflated' : 'Refetched' ),
98             $self->type
99             )
100             ) if ( $self->api->debug );
101              
102             # mark as being a whole object
103 1         34 $self->_partial_object(0);
104              
105 1         42 return $hash;
106             }
107              
108 4 0   4   3491 method _build_name () { return $self->get_hash_item('name'); }
  0     0   0  
  0         0  
  0         0  
109 4 50   4   3121 method _build_id () { return $self->get_hash_item('id'); }
  1     1   2  
  1         4  
  1         40  
110              
111 4 0   4   3100 method _build_uuid () {
  0     0      
  0            
112              
113             # The UUID is in the href - return the first match
114 0           my $path = lc( $self->href->path() );
115 0 0         return $1
116             if ( $path =~ m|\b([0-9a-f]{8}\-[0-9a-f]{4}\-[0-9a-f]{4}\-[0-9a-f]{4}\-[0-9a-f]{12})\b| );
117 0           return;
118             }
119              
120             # ------------------------------------------------------------------------
121              
122             has _links => (
123             is => 'ro',
124             traits => ['Array'],
125             isa => 'ArrayRef[VMware::vCloudDirector2::Link]',
126             lazy => 1,
127             builder => '_build_links',
128             clearer => '_clear_links',
129             handles => { links => 'elements', },
130             );
131             has _all_links => (
132             is => 'ro',
133             traits => ['Array'],
134             isa => 'ArrayRef[VMware::vCloudDirector2::Link]',
135             lazy => 1,
136             builder => '_build_all_links',
137             clearer => '_clear_all_links',
138             handles => { all_links => 'elements', },
139             );
140              
141 4 0   4   3562 method _build_links () {
  0     0      
  0            
142 0           my @links = grep { $_->is_json } $self->all_links;
  0            
143 0           return \@links;
144             }
145              
146 4 0   4   3166 method _build_all_links () {
  0     0      
  0            
147 0           my @links;
148 0 0         if ( exists( $self->hash->{link} ) ) {
149             push( @links, VMware::vCloudDirector2::Link->new( hash => $_, object => $self ) )
150 0           foreach ( $self->_listify( $self->hash->{link} ) );
151             }
152 0           return \@links;
153             }
154              
155             # ------------------------------------------------------------------------
156              
157              
158             has is_admin_object => (
159             is => 'ro',
160             isa => 'Bool',
161             lazy => 1,
162             builder => '_build_is_admin_object',
163             documentation => 'Is this an admin level object?',
164             );
165 4 0   4   3421 method _build_is_admin_object () { return ( $self->href->path() =~ m|/api/admin/| ) ? 1 : 0; }
  0 0   0      
  0            
  0            
166              
167             # ------------------------------------------------------------------------
168              
169              
170 4 0   4   3152 method inflate () {
  0     0      
  0            
171 0 0         $self->refetch if ( $self->_partial_object );
172 0           return $self;
173             }
174              
175             # ------------------------------------------------------------------------
176 4 0   4   3004 method refetch () {
  0     0      
  0            
177              
178             # simplest way to force the object to be refetched is to clear the hash
179             # and then request it which forces a lazy eval
180 0           $self->_clear_hash;
181 0           $self->_clear_links;
182 0           $self->_clear_all_links;
183 0           $self->hash;
184              
185 0           return $self;
186             }
187              
188             # ------------------------------------------------------------------------
189              
190              
191 4 0   4   21164 method find_links (:$name, :$type, :$rel) {
  0 0   0      
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
192 0           my @matched_links;
193 0           foreach my $link ( $self->links ) {
194 0 0 0       if ( not( defined($rel) ) or ( $rel eq ( $link->rel || '' ) ) ) {
      0        
195 0 0 0       if ( not( defined($type) ) or ( $type eq ( $link->type || '' ) ) ) {
      0        
196 0 0 0       if ( not( defined($name) ) or ( $name eq ( $link->name || '' ) ) ) {
      0        
197 0           push( @matched_links, $link );
198             }
199             }
200             }
201             }
202 0           return @matched_links;
203             }
204              
205             # ------------------------------------------------------------------------
206              
207              
208 4     4   10574 method find_link (@criteria) {
  0     0      
  0            
209 0           my @matched_links = $self->find_links(@criteria);
210 0 0         unless ( scalar(@matched_links) ) {
211 0           VMware::vCloudDirector2::Error->throw(
212             { message => sprintf( "No links matching criteria: %s", join( ', ', @criteria ) ),
213             object => $self
214             }
215             );
216             }
217 0           return $matched_links[0];
218             }
219 4     4   9469 method fetch_link (@search_items) { return $self->find_link(@search_items)->GET(); }
  0     0      
  0            
  0            
220              
221             # ------------------------------------------------------------------------
222              
223              
224 4     4   9283 method fetch_links (@search_items) {
  0     0      
  0            
225 0           my @matched_objects;
226 0           foreach my $link ( $self->find_links(@search_items) ) {
227 0           push( @matched_objects, $link->GET() );
228             }
229 0           return @matched_objects;
230             }
231              
232             # ------------------------------------------------------------------------
233 4 0   4   20920 method _create_object ($hash, $type='Thing') {
  0 0   0      
  0 0          
  0            
  0            
  0            
234              
235             # if thing has Link content within it then it is a full object, otherwise it
236             # is just a stub
237             my $object = VMware::vCloudDirector2::Object->new(
238             hash => $hash,
239             api => $self->api,
240 0 0         _partial_object => ( exists( $hash->{link} ) ) ? 0 : 1,
241             );
242 0 0         $self->api->_debug(
    0          
243             sprintf(
244             'Object: [%s] instantiated %s for [%s]',
245             $self->type, ( $object->_partial_object ? 'a stub' : 'an object' ),
246             $object->type
247             )
248             ) if ( $self->api->debug );
249 0           return $object;
250             }
251              
252             # ------------------------------------------------------------------------
253              
254              
255 4 0   4   10156 method build_sub_objects ($type) {
  0 0   0      
  0            
  0            
  0            
256 0           my @objects;
257              
258 0 0         return unless ( exists( $self->hash->{$type} ) );
259 0           foreach my $thing ( $self->_listify( $self->hash->{$type} ) ) {
260 0           push( @objects, $self->_create_object( $thing, $type ) );
261             }
262 0           return @objects;
263             }
264              
265 4 0   4   13130 method build_sub_sub_objects ($type, $subtype) {
  0 0   0      
  0 0          
  0            
  0            
  0            
  0            
266 0           my @objects;
267              
268 0 0 0       return unless ( exists( $self->hash->{$type} ) and is_plain_hashref( $self->hash->{$type} ) );
269 0 0         return unless ( exists( $self->hash->{$type}{$subtype} ) );
270 0           foreach my $thing ( $self->_listify( $self->hash->{$type}{$subtype} ) ) {
271 0           push( @objects, $self->_create_object( $thing, $subtype ) );
272             }
273 0           return @objects;
274             }
275              
276 4 0   4   4150 method build_children_objects () {
  0     0      
  0            
277 0           my $hash = $self->hash;
278 0 0 0       return unless ( exists( $hash->{children} ) and is_plain_hashref( $hash->{children} ) );
279 0           my @objects;
280 0           foreach my $key ( keys %{ $hash->{children} } ) {
  0            
281 0           foreach my $thing ( $self->_listify( $self->hash->{children}{$key} ) ) {
282 0           push( @objects, $self->_create_object( $thing, $key ) );
283             }
284             }
285 0           return @objects;
286             }
287              
288             # ------------------------------------------------------------------------
289              
290              
291 4 0   4   3488 method DELETE () { return $self->api->DELETE( $self->href ); }
  0     0      
  0            
  0            
292              
293              
294 4 0   4   3048 method GET () { return $self->api->GET( $self->href ); }
  0     0      
  0            
  0            
295 4 0   4   3074 method GET_hash () { return $self->api->GET_hash( $self->href ); }
  0     0      
  0            
  0            
296              
297              
298 4 0   4   9186 method POST ($hash) { return $self->api->POST( $self->href, $hash, $self->mime_type ); }
  0 0   0      
  0            
  0            
  0            
  0            
299              
300              
301 4 0   4   9571 method PUT ($hash) { return $self->api->PUT( $self->href, $hash, $self->mime_type ); }
  0 0   0      
  0            
  0            
  0            
  0            
302              
303             # ------------------------------------------------------------------------
304              
305              
306 4 0   4   10215 method fetch_admin_object ($subpath?) {
  0     0      
  0            
  0            
307 0 0 0       if ( $self->is_admin_object and not( defined($subpath) ) ) {
308 0           return $self;
309             }
310             else {
311 0           my $uri = $self->href;
312 0           my $path = $uri->path;
313 0           $path =~ s|^/api/|api/admin/|;
314 0 0         $path .= '/' . $subpath if ( defined($subpath) );
315 0           return $self->api->GET($path);
316             }
317             }
318              
319             # ------------------------------------------------------------------------
320 4 0   4   9674 method _listify ($thing) { !defined $thing ? () : ( ( ref $thing eq 'ARRAY' ) ? @{$thing} : $thing ) }
  0 0   0      
  0 0          
  0 0          
  0            
  0            
  0            
321              
322             # ------------------------------------------------------------------------
323              
324             __PACKAGE__->meta->make_immutable;
325              
326             1;
327              
328             __END__
329              
330             =pod
331              
332             =encoding UTF-8
333              
334             =head1 NAME
335              
336             VMware::vCloudDirector2::Object - Module to contain an object!
337              
338             =head1 VERSION
339              
340             version 0.107
341              
342             =head2 Attributes
343              
344             =head3 api
345              
346             A weak link to the API object to be used.
347              
348             =head3 content
349              
350             The object content. This is in a separate container so that partial objects
351             passed can be inflated at a later stage without having to replace the object
352             itself.
353              
354             =head3 hash
355              
356             A reference to the hash returned from the vCloud API. Forces object inflation.
357              
358             =head3 links
359              
360             Returns L<VMware::vCloudDirector2::Link> objects for each of the JSON targetted
361             links contained in this object. Forces object inflation.
362              
363             =head3 all_links
364              
365             Returns L<VMware::vCloudDirector2::Link> objects for each of the links
366             contained in this object. Will typically return two links per thing - one to
367             the XML version, one to the JSON version. Forces object inflation.
368              
369             =head3 id
370              
371             The id attribute from the returned vCloud JSON. Forces object inflation.
372              
373             =head3 is_admin_object
374              
375             This determines, based on the href path, whether or not this is an admin
376             object.
377              
378             =head2 Methods
379              
380             =head3 inflate
381              
382             If this object is a partial object (ie taken from a link or partial chunk
383             within a containing object), then this forces a refetch of the content from
384             vCloud creating a fully populated object.
385              
386             =head3 refetch
387              
388             Forces a refetch of this object's content unconditionally.
389              
390             =head3 find_links
391              
392             Returns any links found that match the search criteria. The possible criteria
393             are:-
394              
395             =over 4
396              
397             =item name
398              
399             The name of the link
400              
401             =item type
402              
403             The type of the link (short type, not full MIME type)
404              
405             =item rel
406              
407             The rel of the link
408              
409             =back
410              
411             The return value is a list of link objects.
412              
413             =head3 find_link
414              
415             Finds and returns one link that matches the search criteria, exactly as
416             L<find_links>, except that if no links are found an exception is thrown. If
417             multiple links match then the first one returned (normally the first one back
418             from the API) would be returned.
419              
420             The return value is a single link object.
421              
422             =head3 fetch_link
423              
424             As per L</find_link> except that the link found is fetched and expanded up as
425             an object.
426              
427             =head3 fetch_links
428              
429             As per L</find_links> except that each link found is fetched and expanded up as
430             an object.
431              
432             =head3 build_sub_objects
433              
434             Given a type (specifically a key used within the current object hash), grabs
435             the descendants of that key and instantiates them as partial objects (they can
436             then be inflated into full objects).
437              
438             =head3 build_sub_sub_objects
439              
440             Similar to L<build_sub_objects>, but builds objects from two levels down.
441              
442             =head3 build_children_objects
443              
444             Similar to L<build_sub_objects>, but builds objects from within a children hash
445              
446             =head3 DELETE
447              
448             Make a delete request to the URL in this link. Returns Objects. Failure will
449             generate an exception. See L<VMware::vCloudDirector2::API/DELETE>.
450              
451             =head3 GET
452              
453             Make a get request to the URL in this link. Returns Objects. Failure will
454             generate an exception. See L<VMware::vCloudDirector2::API/GET>.
455              
456             =head3 GET_hash
457              
458             Make a get request to the URL in this link. Returns a decoded hash. Failure
459             will generate an exception. See L<VMware::vCloudDirector2::API/GET_hash>.
460              
461             =head3 POST
462              
463             Make a post request with the specified payload to the URL in this link. Returns
464             Objects. Failure will generate an exception. See
465             L<VMware::vCloudDirector2::API/POST>.
466              
467             =head3 PUT
468              
469             Make a put request with the specified payload to the URL in this link. Returns
470             Objects. Failure will generate an exception. See
471             L<VMware::vCloudDirector2::API/PUT>.
472              
473             =head3 fetch_admin_object
474              
475             If this is already an admin object (ie C<is_admin_object> is true), then this
476             object is returned.
477              
478             Otherwise, the path is modified to point to the admin API object and the object
479             is fetched. Since this only exists for a subset of objects there is a
480             reasonable chance that just attempting this will lead to an exception being
481             thrown due to a non-existant object being requested.
482              
483             =head1 AUTHOR
484              
485             Nigel Metheringham <nigelm@cpan.org>
486              
487             =head1 COPYRIGHT AND LICENSE
488              
489             This software is copyright (c) 2019 by Nigel Metheringham.
490              
491             This is free software; you can redistribute it and/or modify it under
492             the same terms as the Perl 5 programming language system itself.
493              
494             =cut