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


line stmt bran cond sub pod time code
1             package OpenStack::MetaAPI;
2              
3 6     6   2761 use strict;
  6         38  
  6         150  
4 6     6   27 use warnings;
  6         24  
  6         140  
5              
6 6     6   2531 use OpenStack::Client::Auth ();
  6         414518  
  6         136  
7 6     6   2467 use OpenStack::MetaAPI::Routes ();
  6         18  
  6         185  
8 6     6   47 use Scalar::Util qw/weaken/;
  6         11  
  6         347  
9              
10 6     6   71 use Moo;
  6         15  
  6         37  
11              
12             # ABSTRACT: Perl5 OpenStack API abstraction on top of OpenStack::Client
13              
14             our $VERSION = '0.003'; # VERSION: generated by DZP::OurPkgVersion
15              
16             has 'debug' => (is => 'rw', default => 0);
17             has 'auth' => (is => 'ro', required => 1, handles => [qw/services/]);
18              
19             has 'route' => (
20             is => 'ro',
21             default => sub {
22             my ($self) = @_;
23              
24             # weaken our circular dependency
25             my $auth = $self->auth;
26             weaken($auth);
27              
28             weaken($self);
29              
30             return OpenStack::MetaAPI::Routes->new(
31             auth => $auth,
32             api => $self);
33             },
34             handles => [OpenStack::MetaAPI::Routes->list_all()],
35             );
36              
37             # for create server
38             has 'create_max_timeout' => (is => 'rw', default => 5 * 60);
39             has 'create_loop_sleep' => (is => 'rw', default => 5);
40              
41             around BUILDARGS => sub {
42             my ($orig, $class, @args) = @_;
43              
44             die "Missing arguments to create Auth object" unless scalar @args;
45              
46             # automagically build the OpenStack::Client::Auth from existing args
47             return {auth => OpenStack::Client::Auth->new(@args)};
48             };
49              
50             sub create_vm {
51 3     3 1 8572 my ($self, %opts) = @_;
52              
53             die "'flavor' name or id is required by create_vm"
54 3 50       11 unless defined $opts{flavor};
55             die "'network' name or id is required by create_vm"
56 3 50       9 unless defined $opts{network};
57             die "'image' name or id is required by create_vm"
58 3 50       6 unless defined $opts{image};
59 3 50       8 die "'name' field is required by create_vm" unless defined $opts{name};
60             die "'network_for_floating_ip' field is required by create_vm"
61 3 50       7 unless defined $opts{network_for_floating_ip};
62              
63             $opts{security_group} //=
64 3   50     18 'default'; # optional argument fallback to 'default'
65              
66             # get the flavor by id or name
67 3         10 my $flavor = $self->look_by_id_or_name(flavors => $opts{flavor});
68              
69             # get the network by id or name
70 3         11 my $network = $self->look_by_id_or_name(networks => $opts{network});
71              
72             # get the network used to add the floating up later
73             my $network_for_floating_ip =
74 3         10 $self->look_by_id_or_name(networks => $opts{network_for_floating_ip});
75              
76 2         3 my $image;
77 2 50       5 if (_looks_valid_id($opts{image})) {
78 2         42 $image = $self->image_from_uid($opts{image});
79             }
80 2   33     3174 $image //= $self->image_from_name($opts{image});
81              
82             my $security_group =
83 2         7 $self->look_by_id_or_name(security_groups => $opts{security_group});
84              
85 2         4 my @extra;
86 2 50       6 if (defined $opts{key_name}) {
87 2         6 push @extra, (key_name => $opts{key_name});
88             }
89              
90             my $server = $self->create_server(
91             name => $opts{name},
92             imageRef => $image->{id},
93             flavorRef => $flavor->{id},
94             min_count => 1,
95             max_count => 1,
96             security_groups => [{name => $security_group->{id}}],
97 2         64 networks => [{uuid => $network->{id}}],
98             @extra,
99             );
100              
101 2         9 my $server_uid = $server->{id};
102 2 50       4 die "Failed to create server" unless _looks_valid_id($server_uid);
103              
104             # we are going to wait for 5 minutes fpr the server
105 2   33     13 my $wait_time_limit = $opts{wait_time_limit} // $self->create_max_timeout;
106              
107 2         4 my $now = time();
108 2         38 my $max_time = $now + $wait_time_limit;
109 2         5 my $server_is_ready;
110              
111             my $server_status;
112              
113             # TODO: maybe add one alarm...
114 2         6 while (time() < $max_time) {
115              
116 5         172 $server_status = $self->server_from_uid($server_uid);
117              
118 5 100 33     35 if ( ref $server_status
      33        
      66        
119             && $server_status->{status}
120             && $server_status->{status}
121             && lc($server_status->{status}) eq 'active') {
122 1         2 $server_is_ready = 1;
123 1         3 last;
124             }
125 4 100       2000391 sleep $self->create_loop_sleep if $self->create_loop_sleep;
126             }
127              
128 2 100       145 die "Failed to create server: never came back as active"
129             unless $server_is_ready;
130              
131             # now add one IP to the server
132             {
133             # create a floating IP
134 1         2 my $floating_ip =
135 1         24 $self->create_floating_ip($network_for_floating_ip->{id});
136              
137             die "Failed to create floating ip"
138 1 50 33     5 unless ref $floating_ip && _looks_valid_id($floating_ip->{id});
139              
140             # add the floating IP to the server
141             my $added =
142 1         22 $self->add_floating_ip_to_server($floating_ip->{id}, $server_uid);
143              
144             $server_status->{floating_ip_address} =
145 1         1632 $floating_ip->{floating_ip_address};
146 1         8 $server_status->{floating_ip_id} = $floating_ip->{id};
147             }
148              
149 1         31 return $server_status;
150             }
151              
152             sub look_by_id_or_name {
153 11     11 0 22 my ($self, $helper, $id_or_name) = @_;
154              
155 11         14 my $entry;
156 11 50       17 if (_looks_valid_id($id_or_name)) {
157 0         0 $entry = $self->can($helper)->($self, id => $id_or_name);
158             }
159 11   66     262 $entry //= $self->can($helper)->($self, name => $id_or_name);
160              
161 11 100 66     36 if (ref $entry ne 'HASH' || !_looks_valid_id($entry->{id})) {
162 1         17 die "Cannot find '$helper' for id/name '$id_or_name'";
163             }
164              
165 10         20 return $entry;
166             }
167              
168             sub _looks_valid_id {
169 26     26   42 my ($id) = @_;
170              
171 26 50       44 return unless defined $id;
172 26 50       39 return if ref $id;
173              
174 26         69 my $VALID_ID = qr{^[a-f0-9\-]+$}i;
175              
176 26         158 return $id =~ $VALID_ID;
177             }
178              
179             1;
180              
181             __END__