File Coverage

blib/lib/VMware/API/vCloud.pm

Criterion	Covered	Total	%
statement	15	410	3.6
branch	0	200	0.0
condition	0	20	0.0
subroutine	5	48	10.4
pod	36	36	100.0
total	56	714	7.8

package VMware::API::vCloud;

# ABSTRACT: VMware vCloud Director

use Data::Dumper;
use LWP;
use XML::Simple;

use warnings;
use strict;

our $VERSION = '2.404'; # VERSION
our $AUTHORITY = 'cpan:NIGELM'; # AUTHORITY

# ADMIN OPTS - http://www.vmware.com/support/vcd/doc/rest-api-doc-1.5-html/landing-admin_operations.html
# USER OPTS - http://www.vmware.com/support/vcd/doc/rest-api-doc-1.5-html/landing-user_operations.html


sub new {
    my $class = shift @_;
    my $self  = {};

    $self->{hostname} = shift @_;
    $self->{username} = shift @_;
    $self->{password} = shift @_;
    $self->{orgname}  = shift @_;

    $self->{debug}        = 0;       # Defaults to no debug info
    $self->{die_on_fault} = 1;       # Defaults to dieing on an error
    $self->{ssl_timeout}  = 3600;    # Defaults to 1h

    $self->{orgname} = 'System' unless $self->{orgname};

    $self->{conf} = shift @_ if defined $_[0] and ref $_[0];
    $self->{debug} = $self->{conf}->{debug} if defined $self->{conf}->{debug};

    bless( $self, $class );

    $self->_regenerate();

    $self->_debug( "Loaded VMware::vCloud v" . our $VERSION . "\n" ) if $self->{debug};
    return $self;
}


sub config {
    my $self = shift @_;

    my %input       = @_;
    my @config_vals = qw/debug die_on_fault hostname orgname password ssl_timeout username/;
    my %config_vals = map { $_, 1; } @config_vals;

    for my $key ( keys %input ) {
        if ( $config_vals{$key} ) {
            $self->{$key} = $input{$key};
        }
        else {
            warn
                'Config key "$key" is being ignored. Only the following options may be configured: '
                . join( ", ", @config_vals ) . "\n";
        }
    }

    $self->_regenerate();

    my %out;
    map { $out{$_} = $self->{$_} } @config_vals;

    return wantarray ? %out : \%out;
}

### Internal methods

# $self->{raw}->{version} - Full data on the API version from login (populated on api_version() call)
# $self->{raw}->{login}
# $self->{learned}->{version} - API version number (populated on api_version() call)
# $self->{learned}->{url}->{login} - Authentication URL (populated on api_version() call)
# $self->{learned}->{url}->{orglist}

sub DESTROY {
    my $self = shift @_;
    my @dump = split "\n", Dumper( $self->{learned} );
    pop @dump;
    shift @dump;
    $self->_debug_with_level( 2, "Learned variables: \n" . join( "\n", @dump ) );
}

sub _debug {
    my $self = shift @_;
    return unless $self->{debug};
    while ( my $debug = shift @_ ) {
        chomp $debug;
        print STDERR "DEBUG: $debug\n";
    }
}

sub _debug_with_level {
    my $self  = shift @_;
    my $value = shift @_;
    return if $self->{debug} < $value;
    $self->_debug(@_);
}

sub _fault {
    my $self  = shift @_;
    my @error = @_;

    my $message = "\nERROR: ";

    if ( scalar @error and ref $error[0] eq 'HTTP::Response' ) {
        if ( $error[0]->content ) {
            $self->_debug( Dumper( \@error ) );
            $self->_debug( 'ERROR Status Line: ' . $error[0]->status_line );
            $self->_debug( 'ERROR Content: ' . $error[0]->content );

            my $ret;    # Try parsing as XML, or fallback to content as message
            eval { $ret = $self->_parse_xml( $error[0]->content ); };
            $message
                .= ( $@ ? $error[0]->content : $error[0]->status_line . ' : ' . $ret->{message} );
        }
        die $message;
    }

    while ( my $error = shift @error ) {
        if ( ref $error eq 'SCALAR' ) {
            chomp $error;
            $message .= $error;
        }
        else {
            $message .= Dumper($error);
        }
    }
}

sub _regenerate {
    my $self = shift @_;
    $self->{ua} = LWP::UserAgent->new;
    $self->_debug_with_level( 2, "VMware::API::vCLoud::_regenerate()" );

    $self->{api_version} = $self->api_version();
    $self->_debug("API Version: $self->{api_version}");

    $self->{url_base} =
        URI->new( 'https://' . $self->{hostname} . '/api/v' . $self->{api_version} . '/' );
    $self->_debug("API URL: $self->{url_base}");
}

sub _xml_response {
    my $self     = shift @_;
    my $response = shift @_;
    $self->_debug_with_level( 3, "Received XML Content: \n\n" . $response->content . "\n\n" );
    if ( $response->is_success ) {
        return unless $response->content;
        return $self->_parse_xml( $response->content );
    }
    else {
        $self->_fault($response);
    }
}

sub _parse_xml {
    my $self = shift @_;
    my $xml  = shift @_;
    my $data = XMLin( $xml, ForceArray => 1 );
    return $data;
}


sub delete {
    my $self = shift @_;
    my $url  = shift @_;
    $self->_debug("API: delete($url)\n") if $self->{debug};
    my $req = HTTP::Request->new( DELETE => $url );
    $req->header( Accept => $self->{learned}->{accept_header} );
    my $response = $self->{ua}->request($req);
    return $self->_xml_response($response);
}


sub get {
    my $self = shift @_;
    my $url = shift @_ || '';
    $self->_debug("API: get($url)\n") if $self->{debug};
    my $req = HTTP::Request->new( GET => $url );
    $req->header( Accept => $self->{learned}->{accept_header} );

    #$self->_debug_with_level(3,"Sending GET: \n\n" . $req->as_string . "\n");
    my $response = $self->{ua}->request($req);
    my $check    = $response->request;
    $self->_debug_with_level( 3, "Sent GET:\n\n" . $check->as_string . "\n" );
    $self->_debug_with_level( 3, "GET returned:\n\n" . $response->as_string . "\n" );
    return $self->_xml_response($response);
}


sub get_raw {
    my $self = shift @_;
    my $url  = shift @_;
    $self->_debug("API: get($url)\n") if $self->{debug};
    my $req = HTTP::Request->new( GET => $url );
    $req->header( Accept => $self->{learned}->{accept_header} );

    #$self->_debug_with_level(3,"Sending GET: \n\n" . $req->as_string . "\n");
    my $response = $self->{ua}->request($req);
    my $check    = $response->request;
    $self->_debug_with_level( 3, "Sent GET:\n\n" . $check->as_string . "\n" );
    $self->_debug_with_level( 3, "GET returned:\n\n" . $response->as_string . "\n" );
    return $response->content;
}


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

    my $type    = shift @_;
    my $content = shift @_;

    $self->_debug("API: post($href)\n") if $self->{debug};
    my $req = HTTP::Request->new( POST => $href );

    $req->content($content)   if $content;
    $req->content_type($type) if $type;
    $req->header( Accept => $self->{learned}->{accept_header} );

    $self->_debug_with_level(
        3,
        "Posting with XML Content-Type: $type",
        "Posting XML content:\n\n$content\n\n"
    );

    my $response = $self->{ua}->request($req);
    my $data     = $self->_xml_response($response);

    my @ret = ( $response->message, $response->code, $data );

    return wantarray ? @ret : \@ret;
}


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

    my $type    = shift @_;
    my $content = shift @_;

    $self->_debug("API: post($href)\n") if $self->{debug};
    my $req = HTTP::Request->new( PUT => $href );

    $req->content($content)   if $content;
    $req->content_type($type) if $type;
    $req->header( Accept => $self->{learned}->{accept_header} );

    $self->_debug_with_level(
        3,
        "Posting with XML Content-Type: $type",
        "Posting XML content:\n\n$content\n\n"
    );

    my $response = $self->{ua}->request($req);
    my $data     = $self->_xml_response($response);

    my @ret = ( $response->message, $response->code, $data );

    return wantarray ? @ret : \@ret;
}


sub api_version {
    my $self = shift @_;
    my $url =
        URI->new( 'https://' . $self->{hostname} . '/api/versions' );    # Check API version first!

    $self->_debug("Checking $url for supported API versions");

    my $req = HTTP::Request->new( GET => $url );
    my $response = $self->{ua}->request($req);
    if ( $response->status_line eq '200 OK' ) {
        my $info = XMLin( $response->content );

        #die Dumper($info);

        $self->{learned}->{version} = 0;
        for my $verblock ( @{ $info->{VersionInfo} } ) {
            if ( $verblock->{Version} > $self->{learned}->{version} ) {
                $self->{raw}->{version}          = $verblock;
                $self->{learned}->{version}      = $verblock->{Version};
                $self->{learned}->{url}->{login} = $verblock->{LoginUrl};
            }
        }

        return $self->{learned}->{version};
    }
    else {
        $self->_fault($response);
    }
}


sub login {
    my $self = shift @_;

    $self->_debug( 'Login URL: ' . $self->{learned}->{url}->{login} );
    my $req = HTTP::Request->new( POST => $self->{learned}->{url}->{login} );

    $req->authorization_basic( $self->{username} . '@' . $self->{orgname}, $self->{password} );
    $self->_debug( "Attempting to login: "
            . $self->{username} . '@'
            . $self->{orgname} . ' '
            . $self->{password} );

    $self->{learned}->{accept_header} = 'application/*+xml;version=' . $self->{learned}->{version};
    $self->_debug( 'Accept header: ' . $self->{learned}->{accept_header} );
    $req->header( Accept => $self->{learned}->{accept_header} );

    my $response = $self->{ua}->request($req);

    my $token = $response->header('x-vcloud-authorization');
    $self->{ua}->default_header( 'x-vcloud-authorization', $token );

    $self->_debug( "Authentication status: " . $response->status_line );
    if ( $response->status_line =~ /^4\d\d/ ) {
        die "ERROR: Login Error: " . $response->status_line;
    }

    $self->_debug( "Authentication token: " . $token );

    $self->{raw}->{login} = $self->_xml_response($response);

    for my $link ( @{ $self->{raw}->{login}->{Link} } ) {
        next if not defined $link->{type};
        $self->{learned}->{url}->{admin} = $link->{href}
            if $link->{type} eq 'application/vnd.vmware.admin.vcloud+xml';
        $self->{learned}->{url}->{entity} = $link->{href}
            if $link->{type} eq 'application/vnd.vmware.vcloud.entity+xml';
        $self->{learned}->{url}->{extensibility} = $link->{href}
            if $link->{type} eq 'application/vnd.vmware.vcloud.apiextensibility+xml';
        $self->{learned}->{url}->{extension} = $link->{href}
            if $link->{type} eq 'application/vnd.vmware.admin.vmwExtension+xml';
        $self->{learned}->{url}->{orglist} = $link->{href}
            if $link->{type} eq 'application/vnd.vmware.vcloud.orgList+xml';
        $self->{learned}->{url}->{query} = $link->{href}
            if $link->{type} eq 'application/vnd.vmware.vcloud.query.queryList+xml';

        #die Dumper($self->{raw}->{login}->{Link});
    }

    $self->{have_session} = 1;
    return $self->{raw}->{login};
}


# http://pubs.vmware.com/vcd-51/topic/com.vmware.vcloud.api.doc_51/GUID-FBAA5B7D-8599-40C2-8081-E6D77DF18D5F.html

sub logout {
    my $self = shift @_;
    $self->_debug("API: logout()\n") if $self->{debug};
    $self->{have_session} = 0;

    my $url = $self->{learned}->{url}->{login};
    $url =~ s/sessions/session/;
    my $req = HTTP::Request->new( DELETE => $self->{learned}->{url}->{login} );
    $req->header( Accept => $self->{learned}->{accept_header} );

    my $response = $self->{ua}->request($req);
    return 1 if $response->code() == 401;    # No content is a successful logout
    return $self->_xml_response($response);
}

### API methods


sub admin {
    my $self = shift @_;
    $self->_debug("API: admin()\n")  if $self->{debug};
    return $self->{learned}->{admin} if defined $self->{learned}->{admin};

    my $parsed = $self->get( $self->{learned}->{url}->{admin} );

    $self->{learned}->{admin}->{networks} = $parsed->{Networks}->[0]->{Network};
    $self->{learned}->{admin}->{rights}   = $parsed->{RightReferences}->[0]->{RightReference};
    $self->{learned}->{admin}->{roles}    = $parsed->{RoleReferences}->[0]->{RoleReference};
    $self->{learned}->{admin}->{orgs} =
        $parsed->{OrganizationReferences}->[0]->{OrganizationReference};
    $self->{learned}->{admin}->{pvdcs} =
        $parsed->{ProviderVdcReferences}->[0]->{ProviderVdcReference};

    return $self->{learned}->{admin};
}


sub admin_extension_get {
    my $self = shift @_;
    $self->_debug("API: admin_extension_get()\n") if $self->{debug};
    return $self->get( $self->{learned}->{url}->{admin} . 'extension' );
}


sub admin_extension_vimServer_get {
    my $self = shift @_;
    my $url  = shift @_;
    $self->_debug("API: admin_extension_vimServer_get($url)\n") if $self->{debug};
    return $self->get($url);
}


sub admin_extension_vimServerReferences_get {
    my $self = shift @_;
    $self->_debug("API: admin_extension_vimServerReferences_get()\n") if $self->{debug};
    return $self->get( $self->{learned}->{url}->{admin} . 'extension/vimServerReferences' );
}


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

# Add catalog item http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Foperations%2FPOST-CreateCatalogItem.html

sub catalog_create {
    my $self = shift @_;
    my $url  = shift @_;
    my $conf = shift @_;

    $conf->{is_published} = 0 unless defined $conf->{is_published};

    $url .= '/catalogs' unless $url =~ /\/catalogs$/;
    $self->_debug("API: catalog_create($url)\n") if $self->{debug};

    my $xml = '
   ' . $conf->{description} . '
   ' . $conf->{is_published} . '
';

    my $ret = $self->post( $url, 'application/vnd.vmware.admin.catalog+xml', $xml );

    return $ret->[2]->{href} if $ret->[1] == 201;
    return $ret;
}


sub catalog_get {
    my $self = shift @_;
    my $cat  = shift @_;
    $self->_debug("API: catalog_get($cat)\n") if $self->{debug};
    return $self->get( $cat =~ /^[^\/]+$/ ? $self->{url_base} . 'catalog/' . $cat : $cat );
}


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

sub catalog_get_access {
    my $self     = shift @_;
    my $cat_href = shift @_;
    my $org_href = shift @_;

    die 'Bad Catalog HREF' unless $cat_href =~ /(\/catalog\/[^\/]+)$/;
    my $href = $org_href . $1 . '/controlAccess';
    $href =~ s/admin\///;

    $self->_debug("API: catalog_get_access($href)\n") if $self->{debug};
    return $self->get($href);
}


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

sub catalog_set_access {
    my $self      = shift @_;
    my $cat_href  = shift @_;
    my $org_href  = shift @_;
    my $is_shared = shift @_;
    my $level     = shift @_;

    die 'Bad Catalog HREF' unless $cat_href =~ /(\/catalog\/[^\/]+)$/;
    my $href = $org_href . $1 . '/action/controlAccess';
    $href =~ s/admin\///;

    $self->_debug("API: catalog_set_access($href)\n") if $self->{debug};

    my $xml = '
    ' . $is_shared . '
    ' . $level . '
';

    my $ret = $self->post( $href, 'application/vnd.vmware.vcloud.controlAccess+xml', $xml );

    return $ret->[2]->{href} if $ret->[1] == 201;
    return $ret;
}


sub datastore_list {
    my $self      = shift @_;
    my $query_url = $self->{learned}->{url}->{query} . '?type=datastore&format=idrecords';
    return $self->get($query_url);
}


# http://pubs.vmware.com/vcd-51/topic/com.vmware.vcloud.api.doc_51/GUID-439C57EA-859C-423C-B21B-22B230395600.html
# http://www.vmware.com/support/vcd/doc/rest-api-doc-1.5-html/operations/PUT-Organization.html

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

    $self->_debug("API: org_create()\n") if $self->{debug};
    my $url = $self->{learned}->{url}->{admin} . 'orgs';

    $conf->{ldap_mode} = 'NONE' unless defined $conf->{ldap_mode};

    my $vapp_lease = '
            0
            0
            0
        ';

    my $tmpl_lease = '
            0
            0
        ';

    my $vdcs;
    if ( defined $conf->{vdc} and ref $conf->{vdc} ) {
        for my $vdc ( @{ $conf->{vdc} } ) {
            $vdcs .= ' ';
        }
    }
    elsif ( defined $conf->{vdc} ) {
        $vdcs = ' ';
    }
    $vdcs .= "\n";

    my $xml = '

  ' . $conf->{desc} . '
  ' . $conf->{fullname} . '
  ' . $conf->{is_enabled} . '


            ' . $conf->{can_publish} . '
            ' . $conf->{deployed} . '
            ' . $conf->{stored} . '
            false
            1

        ' . $vapp_lease . '
        ' . $tmpl_lease . '

          ' . $conf->{ldap_mode} . '



      ' . $vdcs . '


';

    my $ret = $self->post( $url, 'application/vnd.vmware.admin.organization+xml', $xml );

    return $ret->[2]->{href} if $ret->[1] == 201;
    return $ret;
}


sub org_get {
    my $self = shift @_;
    my $org  = shift @_;
    my $req;

    $self->_debug("API: org_get($org)\n") if $self->{debug};
    return $self->get( $org =~ /^[^\/]+$/ ? $self->{url_base} . 'org/' . $org : $org );
}


sub org_list {
    my $self = shift @_;
    $self->_debug("API: org_list()\n") if $self->{debug};
    return $self->get( $self->{learned}->{url}->{orglist} );
}


sub org_network_create {
    my $self = shift @_;
    my $url  = shift @_;
    my $conf = shift @_;

    $conf->{is_shared} = 0 unless defined $conf->{is_shared};

    $self->_debug("API: org_network_create()\n") if $self->{debug};

    #  my $xml = '
    #
    #  '.$desc.'
    #
    #
    #
    #            false
    #            '.$gateway .'
    #            '.$netmask.'
    #            '.$dns1.'
    #            '.$dns2.'
    #            '.$dnssuffix.'
    #
    #
    #                  '.$start_ip.'
    #                  '.$end_ip.'
    #
    #
    #
    #
    #      natRouted
    #
    #
    #      href="https://vcloud.example.com/api/admin/gateway/2000" />
    #   true
    #
    #  ';

    my $xml = '
   name="' . $conf->{name} . '"
   xmlns="http://www.vmware.com/vcloud/v1.5">
   ' . $conf->{desc} . '


         href="' . $conf->{parent_net_href} . '" />
      bridged

  ' . $conf->{is_shared} . '
';

    $url .= '/networks';

    my $ret = $self->post( $url, 'application/vnd.vmware.vcloud.orgVdcNetwork+xml', $xml );

    return $ret->[2]->{href} if $ret->[1] == 201;
    return $ret;
}


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

sub org_vdc_create {
    my $self = shift @_;
    my $url  = shift @_;
    my $conf = shift @_;

    $self->_debug("API: org_vdc_create()\n") if $self->{debug};

    my $networkpool =
        $conf->{np_href} ? '' : '';

    my $sp;
    if ( defined $conf->{sp} and ref $conf->{sp} ) {
        for my $ref ( @{ $conf->{sp} } ) {
            $sp .= '
      ' . $ref->{sp_enabled} . '
      ' . $ref->{sp_units} . '
      ' . $ref->{sp_limit} . '
      ' . $ref->{sp_default} . '

   ';
        }
    }
    elsif ( defined $conf->{sp_enabled} ) {
        $sp = '
      ' . $conf->{sp_enabled} . '
      ' . $conf->{sp_units} . '
      ' . $conf->{sp_limit} . '
      ' . $conf->{sp_default} . '

   ';
    }

    my $xml = '

  ' . $conf->{desc} . '
  ' . $conf->{allocation_model} . '


         ' . $conf->{cpu_unit} . '
         ' . $conf->{cpu_alloc} . '
         ' . $conf->{cpu_limit} . '


         ' . $conf->{mem_unit} . '
         ' . $conf->{mem_alloc} . '
         ' . $conf->{mem_limit} . '


   ' . $conf->{nic_quota} . '
   ' . $conf->{net_quota} . '
   ' . $sp . '
   ' . $conf->{ResourceGuaranteedMemory} . '
   ' . $conf->{ResourceGuaranteedCpu} . '
   ' . $conf->{VCpuInMhz} . '
   ' . $conf->{is_thin_provision} . '
   ' . $networkpool . '

      name="' . $conf->{pvdc_name} . '"
      href="' . $conf->{pvdc_href} . '" />
   ' . $conf->{use_fast_provisioning} . '

  ';

    $url .= '/vdcsparams';

    my $ret = $self->post( $url, 'application/vnd.vmware.admin.createVdcParams+xml', $xml );

    return $ret->[2]->{href} if $ret->[1] == 201;
    return $ret;
}


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

sub org_vdc_update {
    my $self = shift @_;
    my $url  = shift @_;
    my $conf = shift @_;
    $self->_debug("API: org_vdc_update()\n") if $self->{debug};

    my $desc = '' . $conf->{desc} . "\n";
    my $alloc =
        $conf->{allocation_model}
        ? '' . $conf->{allocation_model} . "\n"
        : '';
    my $compute;
    my $nicquota =
        defined $conf->{nic_quota} ? '' . $conf->{nic_quota} . "\n" : '';
    my $netquota =
        defined $conf->{net_quota}
        ? '' . $conf->{net_quota} . "\n"
        : '';
    my $sp;
    my $networkpool =
        $conf->{np_href} ? '' : '';
    my $res_mem =
        defined $conf->{ResourceGuaranteedMemory}
        ? ''
        . $conf->{ResourceGuaranteedMemory}
        . "\n"
        : '';
    my $res_cpu =
        defined $conf->{ResourceGuaranteedCpu}
        ? '' . $conf->{ResourceGuaranteedCpu} . "\n"
        : '';
    my $vcpu =
        defined $conf->{VCpuInMhz} ? '' . $conf->{VCpuInMhz} . "\n" : '';
    my $thin =
        defined $conf->{is_thin_provision}
        ? '' . $conf->{is_thin_provision} . "\n"
        : '';
    my $pvdc =
        $conf->{pvdc_href}
        ? '
756
        . $conf->{pvdc_name}
        . '" href="'
        . $conf->{pvdc_href}
        . "\" />\n"
        : '';
    my $fast =
        defined $conf->{use_fast_provisioning}
        ? '' . $conf->{use_fast_provisioning} . "\n"
        : '';

    if ( defined $conf->{sp} and ref $conf->{sp} ) {
        for my $ref ( @{ $conf->{sp} } ) {
            $sp .= '
      ' . $ref->{sp_enabled} . '
      ' . $ref->{sp_units} . '
      ' . $ref->{sp_limit} . '
      ' . $ref->{sp_default} . '

   ';
        }
    }
    elsif ( defined $conf->{sp_enabled} ) {
        $sp = '
      ' . $conf->{sp_enabled} . '
      ' . $conf->{sp_units} . '
      ' . $conf->{sp_limit} . '
      ' . $conf->{sp_default} . '

   ';
    }

    if ( defined $conf->{cpu_unit} or defined $conf->{mem_unit} ) {
        $compute = '

         ' . $conf->{cpu_unit} . '
         ' . $conf->{cpu_alloc} . '
         ' . $conf->{cpu_limit} . '


         ' . $conf->{mem_unit} . '
         ' . $conf->{mem_alloc} . '
         ' . $conf->{mem_limit} . "

   \n";
    }

    my $href = $conf->{href} ? 'href="' . $conf->{href} . '"' : '';

    my $xml =
          '
        . $href
        . ' name="'
        . $conf->{name} . "\">\n"
        . $desc
        . $alloc
        . $compute
        . $nicquota
        . $netquota
        . $sp
        . $res_mem
        . $res_cpu
        . $vcpu
        . $thin
        . $networkpool
        . $pvdc
        . $fast
        . "\n";

    my $ret = $self->put( $url, 'application/vnd.vmware.admin.vdc+xml', $xml );

    return $ret->[2]->{href} if $ret->[1] == 201;
    return $ret;
}


sub pvdc_get {
    my $self = shift @_;
    my $tmpl = shift @_;
    $self->_debug("API: pvdc_get($tmpl)\n") if $self->{debug};
    return $self->get( $tmpl =~ /^[^\/]+$/ ? $self->{url_base} . 'tmpl/' . $tmpl : $tmpl );
}


# http://pubs.vmware.com/vcd-51/topic/com.vmware.vcloud.api.reference.doc_51/doc/operations/GET-Task.html

sub task_get {
    my $self = shift @_;
    my $href = shift @_;
    $self->_debug("API: task_get($href)\n") if $self->{debug};
    return $self->get($href);
}


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

sub template_get {
    my $self = shift @_;
    my $tmpl = shift @_;
    $self->_debug("API: template_get($tmpl)\n") if $self->{debug};
    return $self->get( $tmpl =~ /^[^\/]+$/ ? $self->{url_base} . 'tmpl/' . $tmpl : $tmpl );
}


# http://www.vmware.com/support/vcd/doc/rest-api-doc-1.5-html/operations/GET-VAppTemplateMetadata.html

sub template_get_metadata {
    my $self = shift @_;
    my $href = shift @_;
    $self->_debug("API: template_get_metadata($href)\n") if $self->{debug};
    return $self->get( $href . '/metadata' );
}


sub vdc_get {
    my $self = shift @_;
    my $vdc  = shift @_;
    $self->_debug("API: vdc_get($vdc)\n") if $self->{debug};
    return $self->get( $vdc =~ /^[^\/]+$/ ? $self->{url_base} . 'vdc/' . $vdc : $vdc );
}


sub vdc_list {
    my $self = shift @_;
    $self->_debug("API: vdc_list()\n") if $self->{debug};
    return $self->get( $self->{learned}->{url}->{admin} . 'vdcs/query' );
}


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

sub vapp_create_from_template {
    my $self = shift @_;
    my $url  = shift @_;

    my $name                    = shift @_;
    my $netid                   = shift @_;
    my $fencemode               = shift @_;
    my $template_href           = shift @_;
    my $IpAddressAllocationMode = shift @_;

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

    $self->_debug("API: vapp_create($url)\n") if $self->{debug};

    # XML to build

    my $xml =
          '
905
        . $name
        . '" xmlns="http://www.vmware.com/vcloud/v1.5" xmlns:ovf="http://schemas.dmtf.org/ovf/envelope/1" >
	Example FTP Server vApp


			Configuration parameters for vAppNetwork



					' . $fencemode . '





  ';

    my $ret =
        $self->post( $url, 'application/vnd.vmware.vcloud.instantiateVAppTemplateParams+xml',
        $xml );
    my $task_href = $ret->[2]->{Tasks}->[0]->{Task}->{task}->{href};
    return wantarray ? ( $task_href, $ret ) : \( $task_href, $ret );
}


# http://pubs.vmware.com/vcd-51/topic/com.vmware.vcloud.api.doc_51/GUID-9E04772F-2BA9-42A9-947D-4EE7A05A6EE0.html

sub vapp_create_from_sources {
    my $self = shift @_;
    my $url  = shift @_;

    my $name                    = shift @_;
    my $netid                   = shift @_;
    my $fencemode               = shift @_;
    my $template_href           = shift @_;
    my $IpAddressAllocationMode = shift @_;

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

    $self->_debug("API: vapp_create($url)\n") if $self->{debug};

    # XML to build
    my $xml = '

950
        . '" xmlns="http://www.vmware.com/vcloud/v1.5" xmlns:ovf="http://schemas.dmtf.org/ovf/envelope/1" >
	Example FTP Server vApp


			Configuration parameters for vAppNetwork



					' . $fencemode . '






';

    return $self->post( $url, 'application/vnd.vmware.vcloud.instantiateVAppTemplateParams+xml',
        $xml );
}


sub vapp_get {
    my $self = shift @_;
    my $vapp = shift @_;
    my $req;

    $self->_debug("API: vapp_get($vapp)\n") if $self->{debug};
    return $self->get( $vapp =~ /^[^\/]+$/ ? $self->{url_base} . 'vApp/vapp-' . $vapp : $vapp );
}


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

sub vapp_get_metadata {
    my $self = shift @_;
    my $href = shift @_;
    $self->_debug("API: vapp_get_metadata($href)\n") if $self->{debug};
    return $self->get( $href . '/metadata' );
}


# POST /vApp/{id}/action/recomposeVApp
# http://www.vmware.com/support/vcd/doc/rest-api-doc-1.5-html/types/RecomposeVAppParamsType.html

sub vapp_recompose_add_vm {
    my $self      = shift @_;
    my $vapp_name = shift @_;
    my $vapp_href = shift @_;
    my $vm_name   = shift @_;
    my $vm_href   = shift @_;

    my $network        = shift @_;
    my $storageProfile = shift @_;

    my $desc = '';

    my $xml =
        '
    ' . $desc . '



     1

        ".$desc."


';

    return $self->post( $vapp_href . '/action/recomposeVApp',
        'application/vnd.vmware.vcloud.recomposeVAppParams+xml', $xml );
}

1;

__END__