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

package VMware::vCloud;

# ABSTRACT: VMware vCloud Director

use Cache::Bounded;
use Data::Dumper;
use VMware::API::vCloud;
use VMware::vCloud::vApp;

use warnings;
use strict;

our $VERSION = '2.403'; # TRIAL VERSION
our $AUTHORITY = 'cpan:NIGELM'; # AUTHORITY


sub new {
    my $class = shift @_;
    our $host = shift @_;
    our $user = shift @_;
    our $pass = shift @_;
    our $org  = shift @_;
    our $conf = shift @_;

    $org = 'System' unless $org;    # Default to "System" org

    my $self = {};
    bless( $self, $class );

    our $cache = new Cache::Bounded;

    $self->{api} = new VMware::API::vCloud( $host, $user, $pass, $org, $conf );
    $self->{raw_login_data} = $self->{api}->login();

    return $self;
}

sub DESTROY {
    my $self = shift @_;
    $self->{api}->logout()
        if defined $self->{api}->{have_session} and $self->{api}->{have_session} > 0;
}


sub debug {
    my $self = shift @_;
    my $val  = shift @_;
    $self->{api}->{debug} = $val;
}


sub login {
    my $self = shift @_;
    return $self->list_orgs(@_);
}


sub purge {
    our $cache->purge();
}

### Standard methods


# bridged, isolated, or natRouted
# NONE, MANUAL, POOL, DHCP

sub create_vapp_from_template {
    my $self = shift @_;
    my $name = shift @_;

    my $vdcid  = shift @_;
    my $tmplid = shift @_;
    my $netid  = shift @_;

    my %template = $self->get_template($tmplid);
    my %vdc      = $self->get_vdc($vdcid);

    my @links = @{ $vdc{Link} };
    my $url;

    for my $ref (@links) {

        #$url = $ref->{href} if $ref->{type} eq 'application/vnd.vmware.vcloud.composeVAppParams+xml';
        $url = $ref->{href}
            if $ref->{type} eq 'application/vnd.vmware.vcloud.instantiateVAppTemplateParams+xml';
    }

    my $fencemode               = 'bridged';    # bridged, isolated, or natRouted
    my $IpAddressAllocationMode = 'POOL';       # NONE, MANUAL, POOL, DHCP
    $self->purge;
    return $self->{api}
        ->vapp_create_from_template( $url, $name, $netid, 'bridged', $template{href}, 'POOL',
        $vdcid, $tmplid );
}


# bridged, isolated, or natRouted
# NONE, MANUAL, POOL, DHCP

sub create_vapp_from_sources {
    my $self = shift @_;
    my $name = shift @_;

    my $vdcid  = shift @_;
    my $tmplid = shift @_;
    my $netid  = shift @_;

    my %template = $self->get_template($tmplid);
    my %vdc      = $self->get_vdc($vdcid);

    my @links = @{ $vdc{Link} };
    my $url;

    for my $ref (@links) {

        #$url = $ref->{href} if $ref->{type} eq 'application/vnd.vmware.vcloud.composeVAppParams+xml';
        $url = $ref->{href}
            if $ref->{type} eq 'application/vnd.vmware.vcloud.instantiateVAppTemplateParams+xml';
    }

    my $fencemode               = 'bridged';    # bridged, isolated, or natRouted
    my $IpAddressAllocationMode = 'POOL';       # NONE, MANUAL, POOL, DHCP

    return $self->{api}
        ->vapp_create_from_sources( $url, $name, $netid, 'bridged', $template{href}, 'POOL',
        $vdcid, $tmplid );
}


sub delete_vapp {
    my $self = shift @_;
    my $href = shift @_;
    $self->purge();    # Clear cache when deleting
    return $self->{api}->delete($href);
}


sub get_vapp {
    my $self = shift @_;
    my $href = shift @_;

    my $vapp = our $cache->get( 'get_vapp:' . $href );
    return $vapp if defined $vapp;

    $vapp = new VMware::vCloud::vApp( $self->{api}, $href );

    $cache->set( 'get_vapp:' . $href, $vapp );
    return $vapp;
}


sub list_vapps {
    my $self  = shift @_;
    my $vapps = our $cache->get('list_vapps:');

    unless ( defined $vapps ) {
        my %vdcs = $self->list_vdcs( $self->{'api'}{'orgname'} );

        for my $vdcid ( keys %vdcs ) {
            my %vdc = $self->get_vdc($vdcid);
            for my $entity ( @{ $vdc{ResourceEntities} } ) {
                for my $name ( keys %{ $entity->{ResourceEntity} } ) {
                    next
                        unless $entity->{ResourceEntity}->{$name}->{type} eq
                        'application/vnd.vmware.vcloud.vApp+xml';
                    my $href = $entity->{ResourceEntity}->{$name}->{href};
                    $vapps->{$href} = $name;
                }
            }
        }
    }

    $cache->set( 'list_vapps:', $vapps );
    return wantarray ? %$vapps : $vapps if defined $vapps;
}


sub get_template {
    my $self = shift @_;
    my $id   = shift @_;

    my $tmpl = our $cache->get( 'get_template:' . $id );
    return %$tmpl if defined $tmpl;

    my $raw_tmpl_data = $self->{api}->template_get($id);

    my %tmpl = %$raw_tmpl_data;

    #$tmpl{description} = $raw_org_data->{Description}->[0];
    #$tmpl{name}        = $raw_org_data->{name};

    #$raw_org_data->{href} =~ /([^\/]+)$/;
    #$org{id} = $1;

    #$org{contains} = {};

    #for my $link ( @{$raw_org_data->{Link}} ) {
    #$link->{type} =~ /^application\/vnd.vmware.vcloud.(\w+)\+xml$/;
    #my $type = $1;
    #$link->{href} =~ /([^\/]+)$/;
    #my $id = $1;

    #next if $type eq 'controlAccess';

    #$org{contains}{$type}{$id} = $link->{name};
    #}

    $cache->set( 'get_template:' . $id, \%tmpl );
    return ( wantarray ? %tmpl : \%tmpl );
}


sub list_templates {
    my $self = shift @_;

    my $templates = our $cache->get('list_templates:');
    return %$templates if defined $templates;

    my %orgs = $self->list_orgs();
    my %vdcs = $self->list_vdcs( $self->{'api'}{'orgname'} );

    my %templates;

    for my $vdcid ( keys %vdcs ) {
        my %vdc = $self->get_vdc($vdcid);
        for my $entity ( @{ $vdc{ResourceEntities} } ) {
            for my $name ( keys %{ $entity->{ResourceEntity} } ) {
                next
                    unless $entity->{ResourceEntity}->{$name}->{type} eq
                    'application/vnd.vmware.vcloud.vAppTemplate+xml';
                my $href = $entity->{ResourceEntity}->{$name}->{href};
                $templates{$href} = $name;
            }
        }
    }

    $cache->set( 'list_templates:', \%templates );
    return %templates;
}


sub create_catalog {
    my $self = shift @_;
    return $self->{api}->catalog_create(@_);
}


# http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Foperations%2FDELETE-Catalog.html

sub delete_catalog {
    my $self = shift @_;
    my $href = shift @_;
    $self->purge();    # Clear cache when deleting
    return $self->{api}->delete($href);
}


sub create_org {
    my $self = shift @_;
    my $conf = shift @_;
    return $self->{api}->org_create($conf);
}


sub delete_org {
    my $self = shift @_;
    my $href = shift @_;
    $self->purge();    # Clear cache when deleting
    return $self->{api}->delete($href);
}


sub delete_org_network {
    my $self = shift @_;
    my $href = shift @_;
    $self->purge();    # Clear cache when deleting
    return $self->{api}->delete($href);
}


sub disable_org {
    my $self = shift @_;
    my $href = shift @_;
    $href .= '/action/disable' unless $href =~ /\/action\/disable$/;
    return $self->{api}->post( $href, undef, '' );
}


sub enable_org {
    my $self = shift @_;
    my $href = shift @_;
    $href .= '/action/enable' unless $href =~ /\/action\/enable$/;
    return $self->{api}->post( $href, undef, '' );
}


sub get_org {
    my $self = shift @_;
    my $id   = shift @_;

    my $org = our $cache->get( 'get_org:' . $id );
    return ( wantarray ? %$org : $org ) if defined $org;

    my $raw_org_data = $self->{api}->org_get($id);

    my %org;
    $org{raw} = $raw_org_data;

    $org{catalogs}    = $raw_org_data->{Catalogs}->[0]->{CatalogReference};
    $org{description} = $raw_org_data->{Description}->[0];
    $org{href}        = $raw_org_data->{href};
    $org{name}        = $raw_org_data->{name};
    $org{networks}    = $raw_org_data->{Networks}->[0]->{Network};
    $org{vdcs}        = $raw_org_data->{Vdcs}->[0]->{Vdc};

    $raw_org_data->{href} =~ /([^\/]+)$/;
    $org{id} = $1;

    $org{contains} = {};

    for my $link ( @{ $raw_org_data->{Link} } ) {
        $link->{type} =~ /^application\/vnd.vmware.vcloud.(\w+)\+xml$/;
        my $type = $1;

        my $id = $link->{href};

        next if $type eq 'controlAccess';

        $org{contains}{$type}{$id} = $link->{name};
    }

    $cache->set( 'get_org:' . $id, \%org );
    return wantarray ? %org : \%org;
}


sub list_orgs {
    my $self = shift @_;
    my $orgs = our $cache->get('list_orgs:');

    unless ( defined $orgs ) {
        $orgs = {};
        my $ret = $self->{api}->org_list();

        for my $orgname ( keys %{ $ret->{Org} } ) {
            warn "Org type of $ret->{Org}->{$orgname}->{type} listed for $orgname\n"
                unless $ret->{Org}->{$orgname}->{type} eq 'application/vnd.vmware.vcloud.org+xml';
            my $href = $ret->{Org}->{$orgname}->{href};
            $orgs->{$orgname} = $href;
        }
        $cache->set( 'list_orgs:', $orgs );
    }

    return wantarray ? %$orgs : $orgs if defined $orgs;
}


sub create_vdc {
    my $self = shift @_;
    my $href = shift @_;
    my $conf = shift @_;
    return $self->{api}->org_vdc_create( $href, $conf );
}


sub delete_vdc {
    my $self = shift @_;
    my $href = shift @_;
    $self->purge();    # Clear cache when deleting
    return $self->{api}->delete($href);
}


sub disable_vdc {
    my $self = shift @_;
    my $href = shift @_;
    $href .= '/action/disable' unless $href =~ /\/action\/disable$/;
    return $self->{api}->post( $href, undef, '' );
}


sub enable_vdc {
    my $self = shift @_;
    my $href = shift @_;
    $href .= '/action/enable' unless $href =~ /\/action\/enable$/;
    return $self->{api}->post( $href, undef, '' );
}


sub get_vdc {
    my $self = shift @_;
    my $id   = shift @_;

    my $vdc = our $cache->get( 'get_vdc:' . $id );
    return %$vdc if defined $vdc;

    my $raw_vdc_data = $self->{api}->vdc_get($id);

    my %vdc;
    $vdc{description} = $raw_vdc_data->{Description}->[0];
    $vdc{name}        = $raw_vdc_data->{name};

    $raw_vdc_data->{href} =~ /([^\/]+)$/;
    $vdc{id} = $1;

    $vdc{contains} = {};

    for my $link ( @{ $raw_vdc_data->{Link} } ) {
        $link->{type} =~ /^application\/vnd.vmware.vcloud.(\w+)\+xml$/;
        my $type = $1;
        $link->{href} =~ /([^\/]+)$/;
        my $id = $1;

        next if $type eq 'controlAccess';

        $vdc{contains}{$type}{$id} = $link->{name};
    }

    $cache->set( 'get_vdc:' . $id, $raw_vdc_data );
    return wantarray ? %$raw_vdc_data : $raw_vdc_data;
}


sub list_vdcs {
    my $self    = shift @_;
    my $orgname = shift @_;
    $orgname = '' if !defined $orgname || $orgname =~ /^[sS]ystem$/; # Show all if the org is System
    my $vdcs = our $cache->get("list_vdcs:$orgname:");

    unless ( defined $vdcs ) {
        $vdcs = {};
        my %orgs = $self->list_orgs();
        %orgs = ( $orgname => $orgs{$orgname} ) if defined $orgname;

        for my $orgname ( keys %orgs ) {
            my %org = $self->get_org( $orgs{$orgname} );
            for my $vdcid ( keys %{ $org{contains}{vdc} } ) {
                $vdcs->{$vdcid} = $org{contains}{vdc}{$vdcid};
            }
        }
    }

    $cache->set( "list_vdcs:$orgname:", $vdcs );
    return wantarray ? %$vdcs : $vdcs;
}


sub get_pvdc {
    my $self = shift @_;
    my $href = shift @_;
    return $self->{api}->pvdc_get($href);
}


sub list_pvdcs {
    my $self = shift @_;
    my $href = shift @_;

    my $admin_urls = $self->admin_urls();
    my $pvdcs      = {};

    for my $name ( keys %{ $admin_urls->{pvdcs} } ) {
        my $href = $admin_urls->{pvdcs}->{$name}->{href};
        $pvdcs->{$href} = $name;
    }

    return wantarray ? %$pvdcs : $pvdcs;
}


sub create_org_network {
    my $self = shift @_;
    my $href = shift @_;
    my $conf = shift @_;
    return $self->{api}->org_network_create( $href, $conf );
}


sub list_networks {
    my $self  = shift @_;
    my $vdcid = shift @_;

    my $networks = our $cache->get("list_networks:$vdcid:");
    return %$networks if defined $networks;

    my %networks;
    my %vdcs = ( $vdcid ? ( $vdcid => 1 ) : $self->list_vdcs() );

    for my $vdcid ( keys %vdcs ) {
        my %vdc      = $self->get_vdc($vdcid);
        my @networks = @{ $vdc{AvailableNetworks} };
        for my $netblock (@networks) {
            for my $name ( keys %{ $netblock->{Network} } ) {
                my $href = $netblock->{Network}->{$name}->{href};
                $networks{$name} = $href;
            }
        }
    }

    $cache->set( "list_networks:$vdcid:", \%networks );
    return %networks;
}


sub get_task {
    my $self = shift @_;
    my $href = shift @_;
    return $self->{api}->task_get($href);
}


sub progress_of_task {
    my $self = shift @_;
    my $href = shift @_;

    my $task   = $self->get_task($href);
    my $status = $task->{status};

    if (   $status eq 'queued'
        or $status eq 'preRunning'
        or $status eq 'running'
        or $status eq 'success' ) {
        return ( $task->{Progress}->[0], $status );
        die Dumper($task);
    }

    return ( ( defined $task->{Progress}->[0] ? $task->{Progress}->[0] : 101 ), $status );
}


sub wait_on_task {
    my $self = shift @_;
    my $href = shift @_;

    my $task   = $self->get_task($href);
    my $status = $task->{status};

    while ( $status eq 'queued' or $status eq 'preRunning' or $status eq 'running' ) {
        sleep 1;
        $task   = $self->get_task($href);
        $status = $task->{status};
    }

    return wantarray ? ( $status, $task ) : [ $status, $task ];
}


sub admin_urls {
    my $self = shift @_;
    return $self->{api}->admin();
}


sub create_external_network {
    my $self = shift @_;
    my $conf = shift @_;

    my $xml = '

   xmlns:vmext="http://www.vmware.com/vcloud/extension/v1.5"
   xmlns:vcloud="http://www.vmware.com/vcloud/v1.5"
   name="' . $conf->{name} . '"
   type="application/vnd.vmware.admin.vmwexternalnet+xml">
   ExternalNet



            false
            ' . $conf->{gateway} . '
            ' . $conf->{subnet} . '
            ' . $conf->{dns1} . '
            ' . $conf->{dns2} . '
            ' . $conf->{suffix} . '


                  ' . $conf->{ipstart} . '
                  ' . $conf->{ipend} . '




      isolated



         href="' . $conf->{vimserver} . '" />
      ' . $conf->{mo_ref} . '
      ' . $conf->{mo_type} . '

';

    return $self->{api}->post( $self->{api}->{learned}->{url}->{admin} . 'extension/externalnets',
        'application/vnd.vmware.admin.vmwexternalnet+xml', $xml );
}


sub extensions {
    my $self = shift @_;
    return $self->{api}->admin_extension_get();
}


sub list_datastores {
    my $self = shift @_;
    my $ret  = $self->{api}->datastore_list();
    return wantarray ? %{ $ret->{DatastoreRecord} } : $ret->{DatastoreRecord};
}


sub list_external_networks {
    my $self       = shift @_;
    my $extensions = $self->extensions();

    my $extnet_url;
    for my $link ( @{ $extensions->{'vcloud:Link'} } ) {
        $extnet_url = $link->{href}
            if $link->{type} eq 'application/vnd.vmware.admin.vmwExternalNetworkReferences+xml';
    }

    my $ret       = $self->{api}->get($extnet_url);
    my $externals = $ret->{'vmext:ExternalNetworkReference'};

    return wantarray ? %$externals : $externals;
}


sub list_portgroups {
    my $self = shift @_;
    my $query =
        $self->{api}->get( 'https://' . our $host . '/api/query?type=portgroup&pageSize=250' );
    my %portgroups = %{ $query->{PortgroupRecord} };
    return wantarray ? %portgroups : \%portgroups;
}


sub vimserver {
    my $self           = shift @_;
    my $ret            = $self->{api}->admin_extension_vimServerReferences_get();
    my $vims           = $ret->{'vmext:VimServerReference'};
    my $vim            = ( keys %$vims )[0];
    my $vimserver_href = $vims->{$vim}->{href};
    return $self->{api}->admin_extension_vimServer_get($vimserver_href);
}


sub webclienturl {
    my $self  = shift @_;
    my $type  = shift @_;
    my $moref = shift @_;

    my $ret            = $self->{api}->admin_extension_vimServerReferences_get();
    my $vims           = $ret->{'vmext:VimServerReference'};
    my $vim            = ( keys %$vims )[0];
    my $vimserver_href = $vims->{$vim}->{href};

    my $urlrequest = $vimserver_href . '/' . $type . '/' . $moref . '/vSphereWebClientUrl';
    return $urlrequest;
}

1;

__END__