File Coverage

blib/lib/VMware/vCloud.pm
Criterion Covered Total %
statement 18 329 5.4
branch 0 84 0.0
condition 0 21 0.0
subroutine 6 48 12.5
pod 41 41 100.0
total 65 523 12.4


line stmt bran cond sub pod time code
1             package VMware::vCloud;
2              
3             # ABSTRACT: VMware vCloud Director
4              
5 2     2   15132 use Cache::Bounded;
  2         1094  
  2         101  
6 2     2   1663 use Data::Dumper;
  2         20412  
  2         261  
7 2     2   1706 use VMware::API::vCloud;
  2         12  
  2         247  
8 2     2   1870 use VMware::vCloud::vApp;
  2         4  
  2         53  
9              
10 2     2   10 use warnings;
  2         2  
  2         105  
11 2     2   16 use strict;
  2         5  
  2         13528  
12              
13             our $VERSION = '2.403'; # TRIAL VERSION
14             our $AUTHORITY = 'cpan:NIGELM'; # AUTHORITY
15              
16              
17             sub new {
18 0     0 1   my $class = shift @_;
19 0           our $host = shift @_;
20 0           our $user = shift @_;
21 0           our $pass = shift @_;
22 0           our $org = shift @_;
23 0           our $conf = shift @_;
24              
25 0 0         $org = 'System' unless $org; # Default to "System" org
26              
27 0           my $self = {};
28 0           bless( $self, $class );
29              
30 0           our $cache = new Cache::Bounded;
31              
32 0           $self->{api} = new VMware::API::vCloud( $host, $user, $pass, $org, $conf );
33 0           $self->{raw_login_data} = $self->{api}->login();
34              
35 0           return $self;
36             }
37              
38             sub DESTROY {
39 0     0     my $self = shift @_;
40             $self->{api}->logout()
41 0 0 0       if defined $self->{api}->{have_session} and $self->{api}->{have_session} > 0;
42             }
43              
44              
45             sub debug {
46 0     0 1   my $self = shift @_;
47 0           my $val = shift @_;
48 0           $self->{api}->{debug} = $val;
49             }
50              
51              
52             sub login {
53 0     0 1   my $self = shift @_;
54 0           return $self->list_orgs(@_);
55             }
56              
57              
58             sub purge {
59 0     0 1   our $cache->purge();
60             }
61              
62             ### Standard methods
63              
64              
65             # bridged, isolated, or natRouted
66             # NONE, MANUAL, POOL, DHCP
67              
68             sub create_vapp_from_template {
69 0     0 1   my $self = shift @_;
70 0           my $name = shift @_;
71              
72 0           my $vdcid = shift @_;
73 0           my $tmplid = shift @_;
74 0           my $netid = shift @_;
75              
76 0           my %template = $self->get_template($tmplid);
77 0           my %vdc = $self->get_vdc($vdcid);
78              
79 0           my @links = @{ $vdc{Link} };
  0            
80 0           my $url;
81              
82 0           for my $ref (@links) {
83              
84             #$url = $ref->{href} if $ref->{type} eq 'application/vnd.vmware.vcloud.composeVAppParams+xml';
85             $url = $ref->{href}
86 0 0         if $ref->{type} eq 'application/vnd.vmware.vcloud.instantiateVAppTemplateParams+xml';
87             }
88              
89 0           my $fencemode = 'bridged'; # bridged, isolated, or natRouted
90 0           my $IpAddressAllocationMode = 'POOL'; # NONE, MANUAL, POOL, DHCP
91 0           $self->purge;
92             return $self->{api}
93 0           ->vapp_create_from_template( $url, $name, $netid, 'bridged', $template{href}, 'POOL',
94             $vdcid, $tmplid );
95             }
96              
97              
98             # bridged, isolated, or natRouted
99             # NONE, MANUAL, POOL, DHCP
100              
101             sub create_vapp_from_sources {
102 0     0 1   my $self = shift @_;
103 0           my $name = shift @_;
104              
105 0           my $vdcid = shift @_;
106 0           my $tmplid = shift @_;
107 0           my $netid = shift @_;
108              
109 0           my %template = $self->get_template($tmplid);
110 0           my %vdc = $self->get_vdc($vdcid);
111              
112 0           my @links = @{ $vdc{Link} };
  0            
113 0           my $url;
114              
115 0           for my $ref (@links) {
116              
117             #$url = $ref->{href} if $ref->{type} eq 'application/vnd.vmware.vcloud.composeVAppParams+xml';
118             $url = $ref->{href}
119 0 0         if $ref->{type} eq 'application/vnd.vmware.vcloud.instantiateVAppTemplateParams+xml';
120             }
121              
122 0           my $fencemode = 'bridged'; # bridged, isolated, or natRouted
123 0           my $IpAddressAllocationMode = 'POOL'; # NONE, MANUAL, POOL, DHCP
124              
125             return $self->{api}
126 0           ->vapp_create_from_sources( $url, $name, $netid, 'bridged', $template{href}, 'POOL',
127             $vdcid, $tmplid );
128             }
129              
130              
131             sub delete_vapp {
132 0     0 1   my $self = shift @_;
133 0           my $href = shift @_;
134 0           $self->purge(); # Clear cache when deleting
135 0           return $self->{api}->delete($href);
136             }
137              
138              
139             sub get_vapp {
140 0     0 1   my $self = shift @_;
141 0           my $href = shift @_;
142              
143 0           my $vapp = our $cache->get( 'get_vapp:' . $href );
144 0 0         return $vapp if defined $vapp;
145              
146 0           $vapp = new VMware::vCloud::vApp( $self->{api}, $href );
147              
148 0           $cache->set( 'get_vapp:' . $href, $vapp );
149 0           return $vapp;
150             }
151              
152              
153             sub list_vapps {
154 0     0 1   my $self = shift @_;
155 0           my $vapps = our $cache->get('list_vapps:');
156              
157 0 0         unless ( defined $vapps ) {
158 0           my %vdcs = $self->list_vdcs( $self->{'api'}{'orgname'} );
159              
160 0           for my $vdcid ( keys %vdcs ) {
161 0           my %vdc = $self->get_vdc($vdcid);
162 0           for my $entity ( @{ $vdc{ResourceEntities} } ) {
  0            
163 0           for my $name ( keys %{ $entity->{ResourceEntity} } ) {
  0            
164             next
165             unless $entity->{ResourceEntity}->{$name}->{type} eq
166 0 0         'application/vnd.vmware.vcloud.vApp+xml';
167 0           my $href = $entity->{ResourceEntity}->{$name}->{href};
168 0           $vapps->{$href} = $name;
169             }
170             }
171             }
172             }
173              
174 0           $cache->set( 'list_vapps:', $vapps );
175 0 0         return wantarray ? %$vapps : $vapps if defined $vapps;
    0          
176             }
177              
178              
179             sub get_template {
180 0     0 1   my $self = shift @_;
181 0           my $id = shift @_;
182              
183 0           my $tmpl = our $cache->get( 'get_template:' . $id );
184 0 0         return %$tmpl if defined $tmpl;
185              
186 0           my $raw_tmpl_data = $self->{api}->template_get($id);
187              
188 0           my %tmpl = %$raw_tmpl_data;
189              
190             #$tmpl{description} = $raw_org_data->{Description}->[0];
191             #$tmpl{name} = $raw_org_data->{name};
192              
193             #$raw_org_data->{href} =~ /([^\/]+)$/;
194             #$org{id} = $1;
195              
196             #$org{contains} = {};
197              
198             #for my $link ( @{$raw_org_data->{Link}} ) {
199             #$link->{type} =~ /^application\/vnd.vmware.vcloud.(\w+)\+xml$/;
200             #my $type = $1;
201             #$link->{href} =~ /([^\/]+)$/;
202             #my $id = $1;
203              
204             #next if $type eq 'controlAccess';
205              
206             #$org{contains}{$type}{$id} = $link->{name};
207             #}
208              
209 0           $cache->set( 'get_template:' . $id, \%tmpl );
210 0 0         return ( wantarray ? %tmpl : \%tmpl );
211             }
212              
213              
214             sub list_templates {
215 0     0 1   my $self = shift @_;
216              
217 0           my $templates = our $cache->get('list_templates:');
218 0 0         return %$templates if defined $templates;
219              
220 0           my %orgs = $self->list_orgs();
221 0           my %vdcs = $self->list_vdcs( $self->{'api'}{'orgname'} );
222              
223 0           my %templates;
224              
225 0           for my $vdcid ( keys %vdcs ) {
226 0           my %vdc = $self->get_vdc($vdcid);
227 0           for my $entity ( @{ $vdc{ResourceEntities} } ) {
  0            
228 0           for my $name ( keys %{ $entity->{ResourceEntity} } ) {
  0            
229             next
230             unless $entity->{ResourceEntity}->{$name}->{type} eq
231 0 0         'application/vnd.vmware.vcloud.vAppTemplate+xml';
232 0           my $href = $entity->{ResourceEntity}->{$name}->{href};
233 0           $templates{$href} = $name;
234             }
235             }
236             }
237              
238 0           $cache->set( 'list_templates:', \%templates );
239 0           return %templates;
240             }
241              
242              
243             sub create_catalog {
244 0     0 1   my $self = shift @_;
245 0           return $self->{api}->catalog_create(@_);
246             }
247              
248              
249             # http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Foperations%2FDELETE-Catalog.html
250              
251             sub delete_catalog {
252 0     0 1   my $self = shift @_;
253 0           my $href = shift @_;
254 0           $self->purge(); # Clear cache when deleting
255 0           return $self->{api}->delete($href);
256             }
257              
258              
259             sub create_org {
260 0     0 1   my $self = shift @_;
261 0           my $conf = shift @_;
262 0           return $self->{api}->org_create($conf);
263             }
264              
265              
266             sub delete_org {
267 0     0 1   my $self = shift @_;
268 0           my $href = shift @_;
269 0           $self->purge(); # Clear cache when deleting
270 0           return $self->{api}->delete($href);
271             }
272              
273              
274             sub delete_org_network {
275 0     0 1   my $self = shift @_;
276 0           my $href = shift @_;
277 0           $self->purge(); # Clear cache when deleting
278 0           return $self->{api}->delete($href);
279             }
280              
281              
282             sub disable_org {
283 0     0 1   my $self = shift @_;
284 0           my $href = shift @_;
285 0 0         $href .= '/action/disable' unless $href =~ /\/action\/disable$/;
286 0           return $self->{api}->post( $href, undef, '' );
287             }
288              
289              
290             sub enable_org {
291 0     0 1   my $self = shift @_;
292 0           my $href = shift @_;
293 0 0         $href .= '/action/enable' unless $href =~ /\/action\/enable$/;
294 0           return $self->{api}->post( $href, undef, '' );
295             }
296              
297              
298             sub get_org {
299 0     0 1   my $self = shift @_;
300 0           my $id = shift @_;
301              
302 0           my $org = our $cache->get( 'get_org:' . $id );
303 0 0         return ( wantarray ? %$org : $org ) if defined $org;
    0          
304              
305 0           my $raw_org_data = $self->{api}->org_get($id);
306              
307 0           my %org;
308 0           $org{raw} = $raw_org_data;
309              
310 0           $org{catalogs} = $raw_org_data->{Catalogs}->[0]->{CatalogReference};
311 0           $org{description} = $raw_org_data->{Description}->[0];
312 0           $org{href} = $raw_org_data->{href};
313 0           $org{name} = $raw_org_data->{name};
314 0           $org{networks} = $raw_org_data->{Networks}->[0]->{Network};
315 0           $org{vdcs} = $raw_org_data->{Vdcs}->[0]->{Vdc};
316              
317 0           $raw_org_data->{href} =~ /([^\/]+)$/;
318 0           $org{id} = $1;
319              
320 0           $org{contains} = {};
321              
322 0           for my $link ( @{ $raw_org_data->{Link} } ) {
  0            
323 0           $link->{type} =~ /^application\/vnd.vmware.vcloud.(\w+)\+xml$/;
324 0           my $type = $1;
325              
326 0           my $id = $link->{href};
327              
328 0 0         next if $type eq 'controlAccess';
329              
330 0           $org{contains}{$type}{$id} = $link->{name};
331             }
332              
333 0           $cache->set( 'get_org:' . $id, \%org );
334 0 0         return wantarray ? %org : \%org;
335             }
336              
337              
338             sub list_orgs {
339 0     0 1   my $self = shift @_;
340 0           my $orgs = our $cache->get('list_orgs:');
341              
342 0 0         unless ( defined $orgs ) {
343 0           $orgs = {};
344 0           my $ret = $self->{api}->org_list();
345              
346 0           for my $orgname ( keys %{ $ret->{Org} } ) {
  0            
347             warn "Org type of $ret->{Org}->{$orgname}->{type} listed for $orgname\n"
348 0 0         unless $ret->{Org}->{$orgname}->{type} eq 'application/vnd.vmware.vcloud.org+xml';
349 0           my $href = $ret->{Org}->{$orgname}->{href};
350 0           $orgs->{$orgname} = $href;
351             }
352 0           $cache->set( 'list_orgs:', $orgs );
353             }
354              
355 0 0         return wantarray ? %$orgs : $orgs if defined $orgs;
    0          
356             }
357              
358              
359             sub create_vdc {
360 0     0 1   my $self = shift @_;
361 0           my $href = shift @_;
362 0           my $conf = shift @_;
363 0           return $self->{api}->org_vdc_create( $href, $conf );
364             }
365              
366              
367             sub delete_vdc {
368 0     0 1   my $self = shift @_;
369 0           my $href = shift @_;
370 0           $self->purge(); # Clear cache when deleting
371 0           return $self->{api}->delete($href);
372             }
373              
374              
375             sub disable_vdc {
376 0     0 1   my $self = shift @_;
377 0           my $href = shift @_;
378 0 0         $href .= '/action/disable' unless $href =~ /\/action\/disable$/;
379 0           return $self->{api}->post( $href, undef, '' );
380             }
381              
382              
383             sub enable_vdc {
384 0     0 1   my $self = shift @_;
385 0           my $href = shift @_;
386 0 0         $href .= '/action/enable' unless $href =~ /\/action\/enable$/;
387 0           return $self->{api}->post( $href, undef, '' );
388             }
389              
390              
391             sub get_vdc {
392 0     0 1   my $self = shift @_;
393 0           my $id = shift @_;
394              
395 0           my $vdc = our $cache->get( 'get_vdc:' . $id );
396 0 0         return %$vdc if defined $vdc;
397              
398 0           my $raw_vdc_data = $self->{api}->vdc_get($id);
399              
400 0           my %vdc;
401 0           $vdc{description} = $raw_vdc_data->{Description}->[0];
402 0           $vdc{name} = $raw_vdc_data->{name};
403              
404 0           $raw_vdc_data->{href} =~ /([^\/]+)$/;
405 0           $vdc{id} = $1;
406              
407 0           $vdc{contains} = {};
408              
409 0           for my $link ( @{ $raw_vdc_data->{Link} } ) {
  0            
410 0           $link->{type} =~ /^application\/vnd.vmware.vcloud.(\w+)\+xml$/;
411 0           my $type = $1;
412 0           $link->{href} =~ /([^\/]+)$/;
413 0           my $id = $1;
414              
415 0 0         next if $type eq 'controlAccess';
416              
417 0           $vdc{contains}{$type}{$id} = $link->{name};
418             }
419              
420 0           $cache->set( 'get_vdc:' . $id, $raw_vdc_data );
421 0 0         return wantarray ? %$raw_vdc_data : $raw_vdc_data;
422             }
423              
424              
425             sub list_vdcs {
426 0     0 1   my $self = shift @_;
427 0           my $orgname = shift @_;
428 0 0 0       $orgname = '' if !defined $orgname || $orgname =~ /^[sS]ystem$/; # Show all if the org is System
429 0           my $vdcs = our $cache->get("list_vdcs:$orgname:");
430              
431 0 0         unless ( defined $vdcs ) {
432 0           $vdcs = {};
433 0           my %orgs = $self->list_orgs();
434 0 0         %orgs = ( $orgname => $orgs{$orgname} ) if defined $orgname;
435              
436 0           for my $orgname ( keys %orgs ) {
437 0           my %org = $self->get_org( $orgs{$orgname} );
438 0           for my $vdcid ( keys %{ $org{contains}{vdc} } ) {
  0            
439 0           $vdcs->{$vdcid} = $org{contains}{vdc}{$vdcid};
440             }
441             }
442             }
443              
444 0           $cache->set( "list_vdcs:$orgname:", $vdcs );
445 0 0         return wantarray ? %$vdcs : $vdcs;
446             }
447              
448              
449             sub get_pvdc {
450 0     0 1   my $self = shift @_;
451 0           my $href = shift @_;
452 0           return $self->{api}->pvdc_get($href);
453             }
454              
455              
456             sub list_pvdcs {
457 0     0 1   my $self = shift @_;
458 0           my $href = shift @_;
459              
460 0           my $admin_urls = $self->admin_urls();
461 0           my $pvdcs = {};
462              
463 0           for my $name ( keys %{ $admin_urls->{pvdcs} } ) {
  0            
464 0           my $href = $admin_urls->{pvdcs}->{$name}->{href};
465 0           $pvdcs->{$href} = $name;
466             }
467              
468 0 0         return wantarray ? %$pvdcs : $pvdcs;
469             }
470              
471              
472             sub create_org_network {
473 0     0 1   my $self = shift @_;
474 0           my $href = shift @_;
475 0           my $conf = shift @_;
476 0           return $self->{api}->org_network_create( $href, $conf );
477             }
478              
479              
480             sub list_networks {
481 0     0 1   my $self = shift @_;
482 0           my $vdcid = shift @_;
483              
484 0           my $networks = our $cache->get("list_networks:$vdcid:");
485 0 0         return %$networks if defined $networks;
486              
487 0           my %networks;
488 0 0         my %vdcs = ( $vdcid ? ( $vdcid => 1 ) : $self->list_vdcs() );
489              
490 0           for my $vdcid ( keys %vdcs ) {
491 0           my %vdc = $self->get_vdc($vdcid);
492 0           my @networks = @{ $vdc{AvailableNetworks} };
  0            
493 0           for my $netblock (@networks) {
494 0           for my $name ( keys %{ $netblock->{Network} } ) {
  0            
495 0           my $href = $netblock->{Network}->{$name}->{href};
496 0           $networks{$name} = $href;
497             }
498             }
499             }
500              
501 0           $cache->set( "list_networks:$vdcid:", \%networks );
502 0           return %networks;
503             }
504              
505              
506             sub get_task {
507 0     0 1   my $self = shift @_;
508 0           my $href = shift @_;
509 0           return $self->{api}->task_get($href);
510             }
511              
512              
513             sub progress_of_task {
514 0     0 1   my $self = shift @_;
515 0           my $href = shift @_;
516              
517 0           my $task = $self->get_task($href);
518 0           my $status = $task->{status};
519              
520 0 0 0       if ( $status eq 'queued'
      0        
      0        
521             or $status eq 'preRunning'
522             or $status eq 'running'
523             or $status eq 'success' ) {
524 0           return ( $task->{Progress}->[0], $status );
525 0           die Dumper($task);
526             }
527              
528 0 0         return ( ( defined $task->{Progress}->[0] ? $task->{Progress}->[0] : 101 ), $status );
529             }
530              
531              
532             sub wait_on_task {
533 0     0 1   my $self = shift @_;
534 0           my $href = shift @_;
535              
536 0           my $task = $self->get_task($href);
537 0           my $status = $task->{status};
538              
539 0   0       while ( $status eq 'queued' or $status eq 'preRunning' or $status eq 'running' ) {
      0        
540 0           sleep 1;
541 0           $task = $self->get_task($href);
542 0           $status = $task->{status};
543             }
544              
545 0 0         return wantarray ? ( $status, $task ) : [ $status, $task ];
546             }
547              
548              
549             sub admin_urls {
550 0     0 1   my $self = shift @_;
551 0           return $self->{api}->admin();
552             }
553              
554              
555             sub create_external_network {
556 0     0 1   my $self = shift @_;
557 0           my $conf = shift @_;
558              
559             my $xml = '
560            
561             xmlns:vmext="http://www.vmware.com/vcloud/extension/v1.5"
562             xmlns:vcloud="http://www.vmware.com/vcloud/v1.5"
563             name="' . $conf->{name} . '"
564             type="application/vnd.vmware.admin.vmwexternalnet+xml">
565             ExternalNet
566            
567            
568            
569             false
570             ' . $conf->{gateway} . '
571             ' . $conf->{subnet} . '
572             ' . $conf->{dns1} . '
573             ' . $conf->{dns2} . '
574             ' . $conf->{suffix} . '
575            
576            
577             ' . $conf->{ipstart} . '
578             ' . $conf->{ipend} . '
579            
580            
581            
582            
583             isolated
584            
585            
586            
587             href="' . $conf->{vimserver} . '" />
588             ' . $conf->{mo_ref} . '
589 0           ' . $conf->{mo_type} . '
590            
591             ';
592              
593 0           return $self->{api}->post( $self->{api}->{learned}->{url}->{admin} . 'extension/externalnets',
594             'application/vnd.vmware.admin.vmwexternalnet+xml', $xml );
595             }
596              
597              
598             sub extensions {
599 0     0 1   my $self = shift @_;
600 0           return $self->{api}->admin_extension_get();
601             }
602              
603              
604             sub list_datastores {
605 0     0 1   my $self = shift @_;
606 0           my $ret = $self->{api}->datastore_list();
607 0 0         return wantarray ? %{ $ret->{DatastoreRecord} } : $ret->{DatastoreRecord};
  0            
608             }
609              
610              
611             sub list_external_networks {
612 0     0 1   my $self = shift @_;
613 0           my $extensions = $self->extensions();
614              
615 0           my $extnet_url;
616 0           for my $link ( @{ $extensions->{'vcloud:Link'} } ) {
  0            
617             $extnet_url = $link->{href}
618 0 0         if $link->{type} eq 'application/vnd.vmware.admin.vmwExternalNetworkReferences+xml';
619             }
620              
621 0           my $ret = $self->{api}->get($extnet_url);
622 0           my $externals = $ret->{'vmext:ExternalNetworkReference'};
623              
624 0 0         return wantarray ? %$externals : $externals;
625             }
626              
627              
628             sub list_portgroups {
629 0     0 1   my $self = shift @_;
630             my $query =
631 0           $self->{api}->get( 'https://' . our $host . '/api/query?type=portgroup&pageSize=250' );
632 0           my %portgroups = %{ $query->{PortgroupRecord} };
  0            
633 0 0         return wantarray ? %portgroups : \%portgroups;
634             }
635              
636              
637             sub vimserver {
638 0     0 1   my $self = shift @_;
639 0           my $ret = $self->{api}->admin_extension_vimServerReferences_get();
640 0           my $vims = $ret->{'vmext:VimServerReference'};
641 0           my $vim = ( keys %$vims )[0];
642 0           my $vimserver_href = $vims->{$vim}->{href};
643 0           return $self->{api}->admin_extension_vimServer_get($vimserver_href);
644             }
645              
646              
647             sub webclienturl {
648 0     0 1   my $self = shift @_;
649 0           my $type = shift @_;
650 0           my $moref = shift @_;
651              
652 0           my $ret = $self->{api}->admin_extension_vimServerReferences_get();
653 0           my $vims = $ret->{'vmext:VimServerReference'};
654 0           my $vim = ( keys %$vims )[0];
655 0           my $vimserver_href = $vims->{$vim}->{href};
656              
657 0           my $urlrequest = $vimserver_href . '/' . $type . '/' . $moref . '/vSphereWebClientUrl';
658 0           return $urlrequest;
659             }
660              
661             1;
662              
663             __END__