File Coverage

blib/lib/OpenStack/MetaAPI.pm

Criterion	Covered	Total	%
statement	69	70	98.5
branch	20	32	62.5
condition	12	26	46.1
subroutine	9	9	100.0
pod	1	2	50.0
total	111	139	79.8

package OpenStack::MetaAPI;

use strict;
use warnings;

use OpenStack::Client::Auth    ();
use OpenStack::MetaAPI::Routes ();
use Scalar::Util qw/weaken/;

use Moo;

# ABSTRACT: Perl5 OpenStack API abstraction on top of OpenStack::Client

our $VERSION = '0.002'; # VERSION: generated by DZP::OurPkgVersion

has 'debug' => (is => 'rw', default => 0);
has 'auth' => (is => 'ro', required => 1, handles => [qw/services/]);

has 'route' => (
    is      => 'ro',
    default => sub {
        my ($self) = @_;

        # weaken our circular dependency
        my $auth = $self->auth;
        weaken($auth);

        weaken($self);

        return OpenStack::MetaAPI::Routes->new(
            auth => $auth,
            api  => $self);
    },
    handles => [OpenStack::MetaAPI::Routes->list_all()],
);

# for create server
has 'create_max_timeout' => (is => 'rw', default => 5 * 60);
has 'create_loop_sleep'  => (is => 'rw', default => 5);

around BUILDARGS => sub {
    my ($orig, $class, @args) = @_;

    die "Missing arguments to create Auth object" unless scalar @args;

    # automagically build the OpenStack::Client::Auth from existing args
    return {auth => OpenStack::Client::Auth->new(@args)};
};

sub create_vm {
    my ($self, %opts) = @_;

    die "'flavor' name or id is required by create_vm"
      unless defined $opts{flavor};
    die "'network' name or id is required by create_vm"
      unless defined $opts{network};
    die "'image' name or id is required by create_vm"
      unless defined $opts{image};
    die "'name' field is required by create_vm" unless defined $opts{name};
    die "'network_for_floating_ip' field is required by create_vm"
      unless defined $opts{network_for_floating_ip};

    $opts{security_group} //=
      'default';    # optional argument fallback to 'default'

    # get the flavor by id or name
    my $flavor = $self->look_by_id_or_name(flavors => $opts{flavor});

    # get the network by id or name
    my $network = $self->look_by_id_or_name(networks => $opts{network});

    # get the network used to add the floating up later
    my $network_for_floating_ip =
      $self->look_by_id_or_name(networks => $opts{network_for_floating_ip});

    my $image;
    if (_looks_valid_id($opts{image})) {
        $image = $self->image_from_uid($opts{image});
    }
    $image //= $self->image_from_name($opts{image});

    my $security_group =
      $self->look_by_id_or_name(security_groups => $opts{security_group});

    my @extra;
    if (defined $opts{key_name}) {
        push @extra, (key_name => $opts{key_name});
    }

    my $server = $self->create_server(
        name            => $opts{name},
        imageRef        => $image->{id},
        flavorRef       => $flavor->{id},
        min_count       => 1,
        max_count       => 1,
        security_groups => [{name => $security_group->{id}}],
        networks        => [{uuid => $network->{id}}],
        @extra,
    );

    my $server_uid = $server->{id};
    die "Failed to create server" unless _looks_valid_id($server_uid);

    # we are going to wait for 5 minutes fpr the server
    my $wait_time_limit = $opts{wait_time_limit} // $self->create_max_timeout;

    my $now      = time();
    my $max_time = $now + $wait_time_limit;
    my $server_is_ready;

    my $server_status;

    # TODO: maybe add one alarm...
    while (time() < $max_time) {

        $server_status = $self->server_from_uid($server_uid);

        if (   ref $server_status
            && $server_status->{status}
            && $server_status->{status}
            && lc($server_status->{status}) eq 'active') {
            $server_is_ready = 1;
            last;
        }
        sleep $self->create_loop_sleep if $self->create_loop_sleep;
    }

    die "Failed to create server: never came back as active"
      unless $server_is_ready;

    # now add one IP to the server
    {
        # create a floating IP
        my $floating_ip =
          $self->create_floating_ip($network_for_floating_ip->{id});

        die "Failed to create floating ip"
          unless ref $floating_ip && _looks_valid_id($floating_ip->{id});

        # add the floating IP to the server
        my $added =
          $self->add_floating_ip_to_server($floating_ip->{id}, $server_uid);

        $server_status->{floating_ip_address} =
          $floating_ip->{floating_ip_address};
        $server_status->{floating_ip_id} = $floating_ip->{id};
    }

    return $server_status;
}

sub look_by_id_or_name {
    my ($self, $helper, $id_or_name) = @_;

    my $entry;
    if (_looks_valid_id($id_or_name)) {
        $entry = $self->can($helper)->($self, id => $id_or_name);
    }
    $entry //= $self->can($helper)->($self, name => $id_or_name);

    if (ref $entry ne 'HASH' || !_looks_valid_id($entry->{id})) {
        die "Cannot find '$helper' for id/name '$id_or_name'";
    }

    return $entry;
}

sub _looks_valid_id {
    my ($id) = @_;

    return unless defined $id;
    return if ref $id;

    my $VALID_ID = qr{^[a-f0-9\-]+$}i;

    return $id =~ $VALID_ID;
}

1;

__END__