File Coverage

blib/lib/VMware/vCloudDirector/Object.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package VMware::vCloudDirector::Object;
2              
3             # ABSTRACT: Module to contain an object!
4              
5 1     1   1695 use strict;
  1         2  
  1         54  
6 1     1   6 use warnings;
  1         2  
  1         47  
7              
8             our $VERSION = '0.006'; # VERSION
9             our $AUTHORITY = 'cpan:NIGELM'; # AUTHORITY
10              
11 1     1   5 use Moose;
  1         2  
  1         7  
12 1     1   6299 use Method::Signatures;
  0            
  0            
13             use Ref::Util qw(is_plain_hashref);
14             use Lingua::EN::Inflexion;
15             use VMware::vCloudDirector::ObjectContent;
16              
17             # ------------------------------------------------------------------------
18              
19              
20             has api => (
21             is => 'ro',
22             isa => 'VMware::vCloudDirector::API',
23             required => 1,
24             weak_ref => 1,
25             documentation => 'API we use'
26             );
27              
28             has content => (
29             is => 'ro',
30             isa => 'VMware::vCloudDirector::ObjectContent',
31             predicate => 'has_content',
32             writer => '_set_content',
33             documentation => 'The underlying content object',
34             handles => [qw( mime_type href type name )],
35             );
36              
37             has _partial_object => ( is => 'rw', isa => 'Bool', default => 0 );
38              
39             # delegates that force a full object to be pulled
40             method hash () { return $self->inflate->content->hash; }
41             method links () { return $self->inflate->content->links; }
42             method id () { return $self->inflate->content->id; }
43              
44             # ------------------------------------------------------------------------
45             method BUILD ($args) {
46              
47             $self->_set_content(
48             VMware::vCloudDirector::ObjectContent->new( object => $self, hash => $args->{hash} ) );
49             }
50              
51             # ------------------------------------------------------------------------
52              
53              
54             method inflate () {
55             $self->refetch if ( $self->_partial_object );
56             return $self;
57             }
58              
59             # ------------------------------------------------------------------------
60             method refetch () {
61             my $hash = $self->api->GET_hash( $self->href );
62             $self->_set_content(
63             VMware::vCloudDirector::ObjectContent->new( object => $self, hash => $hash ) );
64             $self->api->_debug(
65             sprintf(
66             'Object: %s a [%s]',
67             ( $self->_partial_object ? 'Inflated' : 'Refetched' ),
68             $self->type
69             )
70             ) if ( $self->api->debug );
71             $self->_partial_object(0);
72             return $self;
73             }
74              
75             # ------------------------------------------------------------------------
76              
77              
78             method find_links (:$name, :$type, :$rel) {
79             my @matched_links;
80             my $links = $self->links;
81             foreach my $link ( @{$links} ) {
82             if ( not( defined($rel) ) or ( $rel eq ( $link->rel || '' ) ) ) {
83             if ( not( defined($type) ) or ( $type eq ( $link->type || '' ) ) ) {
84             if ( not( defined($name) ) or ( $name eq ( $link->name || '' ) ) ) {
85             push( @matched_links, $link );
86             }
87             }
88             }
89             }
90             return @matched_links;
91             }
92              
93             # ------------------------------------------------------------------------
94              
95              
96             method fetch_links (@search_items) {
97             my @matched_objects;
98             foreach my $link ( $self->find_links(@search_items) ) {
99             push( @matched_objects, $link->GET() );
100             }
101             return @matched_objects;
102             }
103              
104             # ------------------------------------------------------------------------
105             method _create_object ($hash, $type='Thing') {
106              
107             # if thing has Link content within it then it is a full object, otherwise it
108             # is just a stub
109             my $object = VMware::vCloudDirector::Object->new(
110             hash => { $type => $hash },
111             api => $self->api,
112             _partial_object => ( exists( $hash->{Link} ) ) ? 0 : 1,
113             );
114             $self->api->_debug(
115             sprintf(
116             'Object: [%s] instantiated %s for [%s]',
117             $self->type, ( $object->_partial_object ? 'a stub' : 'an object' ),
118             $object->type
119             )
120             ) if ( $self->api->debug );
121             return $object;
122             }
123              
124             # ------------------------------------------------------------------------
125              
126              
127             method build_sub_objects ($type) {
128             my @objects;
129             my $container_type = noun($type)->plural;
130             return
131             unless ( exists( $self->hash->{$container_type} )
132             and is_plain_hashref( $self->hash->{$container_type} ) );
133             foreach my $thing ( $self->_listify( $self->hash->{$container_type}{$type} ) ) {
134             push( @objects, $self->_create_object( $thing, $type ) );
135             }
136             return @objects;
137             }
138              
139             method build_children_objects () {
140             my $hash = $self->hash;
141             return unless ( exists( $hash->{Children} ) and is_plain_hashref( $hash->{Children} ) );
142             my @objects;
143             foreach my $key ( keys %{ $hash->{Children} } ) {
144             foreach my $thing ( $self->_listify( $self->hash->{Children}{$key} ) ) {
145             push( @objects, $self->_create_object( $thing, $key ) );
146             }
147             }
148             return @objects;
149             }
150              
151             # ------------------------------------------------------------------------
152              
153              
154             method DELETE () { return $self->api->GET( $self->href ); }
155              
156              
157             method GET () { return $self->api->GET( $self->href ); }
158              
159              
160             method POST ($xml_hash) { return $self->api->GET( $self->href, $xml_hash ); }
161              
162              
163             method PUT ($xml_hash) { return $self->api->GET( $self->href, $xml_hash ); }
164              
165             # ------------------------------------------------------------------------
166             method _listify ($thing) { !defined $thing ? () : ( ( ref $thing eq 'ARRAY' ) ? @{$thing} : $thing ) }
167              
168             # ------------------------------------------------------------------------
169              
170             __PACKAGE__->meta->make_immutable;
171              
172             1;
173              
174             __END__
175              
176             =pod
177              
178             =encoding UTF-8
179              
180             =head1 NAME
181              
182             VMware::vCloudDirector::Object - Module to contain an object!
183              
184             =head1 VERSION
185              
186             version 0.006
187              
188             =head2 Attributes
189              
190             =head3 api
191              
192             A weak link to the API object to be used.
193              
194             =head3 content
195              
196             The object content. This is in a separate container so that partial objects
197             passed can be inflated at a later stage without having to replace the object
198             itself.
199              
200             =head3 hash
201              
202             A reference to the hash returned from the vCloud XML. Forces object inflation.
203              
204             =head3 links
205              
206             An array references to the links contained in this object. Forces object
207             inflation.
208              
209             =head3 id
210              
211             The id attribute from the returned vCloud XML. Forces object inflation.
212              
213             =head2 Methods
214              
215             =head3 inflate
216              
217             If this object is a partial object (ie taken from a link or partial chunk
218             within a containing object), then this forces a refetch of the content from
219             vCloud creating a fully populated object.
220              
221             =head3 refetch
222              
223             Forces a refetch of this object's content unconditionally.
224              
225             =head3 find_links
226              
227             Returns any links found that match the search criteria. The possible criteria
228             are:-
229              
230             =over 4
231              
232             =item name
233              
234             The name of the link
235              
236             =item type
237              
238             The type of the link (short type, not full MIME type)
239              
240             =item rel
241              
242             The rel of the link
243              
244             =back
245              
246             The return value is a list of link objects.
247              
248             =head3 fetch_links
249              
250             As per L</find_links> except that each link found is fetched and expanded up as
251             an object.
252              
253             =head3 build_sub_objects
254              
255             Given a type (specifically a key used within the current object hash), grabs
256             the descendants of that key and instantiates them as partial objects (they can
257             then be inflated into full objects).
258              
259             Due to the structure of the XML there will always be two layers, the inner
260             named singular thing, and the outer named as the plural of thing. Hence this
261             does magic with the language inflection module.
262              
263             =head3 DELETE
264              
265             Make a delete request to the URL of this object. Returns Objects. Failure
266             will generate an exception. See L<VMware::vCloudDirector::API/DELETE>.
267              
268             =head3 GET
269              
270             Make a get request to the URL of this object. Returns Objects. Failure will
271             generate an exception. See L<VMware::vCloudDirector::API/GET>.
272              
273             =head3 POST
274              
275             Make a post request with the specified payload to the URL of this object.
276             Returns Objects. Failure will generate an exception. See
277             L<VMware::vCloudDirector::API/POST>.
278              
279             =head3 PUT
280              
281             Make a put request with the specified payload to the URL of this object.
282             Returns Objects. Failure will generate an exception. See
283             L<VMware::vCloudDirector::API/PUT>.
284              
285             =head1 AUTHOR
286              
287             Nigel Metheringham <nigelm@cpan.org>
288              
289             =head1 COPYRIGHT AND LICENSE
290              
291             This software is copyright (c) 2017 by Nigel Metheringham.
292              
293             This is free software; you can redistribute it and/or modify it under
294             the same terms as the Perl 5 programming language system itself.
295              
296             =cut