File Coverage

blib/lib/Net/OpenNebula.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             #
2             # (c) Jan Gehring <jan.gehring@gmail.com>
3             #
4             # vim: set ts=3 sw=3 tw=0:
5             # vim: set expandtab:
6             #
7 1     1   779 use strict;
  1         3  
  1         46  
8 1     1   8 use warnings;
  1         1  
  1         85  
9              
10             =head1 NAME
11              
12             Net::OpenNebula - Access OpenNebula RPC via Perl.
13              
14             =head1 DESCRIPTION
15              
16             With this module you can access the OpenNebula XML-RPC service.
17              
18             =head1 SYNOPSIS
19              
20             use Net::OpenNebula;
21             my $one = Net::OpenNebula->new(
22             url => "http://server:2633/RPC2",
23             user => "oneadmin",
24             password => "onepass",
25             );
26              
27             my @vms = $one->get_vms();
28              
29             =cut
30              
31             package Net::OpenNebula;
32             $Net::OpenNebula::VERSION = '0.309.0';
33 1     1   414 use Net::OpenNebula::RPCClient;
  0            
  0            
34             push our @ISA , qw(Net::OpenNebula::RPCClient);
35              
36             use Data::Dumper;
37              
38             use Net::OpenNebula::Cluster;
39             use Net::OpenNebula::Datastore;
40             use Net::OpenNebula::Group;
41             use Net::OpenNebula::Host;
42             use Net::OpenNebula::Image;
43             use Net::OpenNebula::Template;
44             use Net::OpenNebula::User;
45             use Net::OpenNebula::VM;
46             use Net::OpenNebula::VNet;
47              
48             sub get_clusters {
49             my ($self, $nameregex) = @_;
50              
51             my $new = Net::OpenNebula::Cluster->new(rpc => $self);
52             return $new->_get_instances($nameregex);
53             }
54              
55             sub get_datastores {
56             my ($self, $nameregex) = @_;
57              
58             my $new = Net::OpenNebula::Datastore->new(rpc => $self);
59             return $new->_get_instances($nameregex);
60             }
61              
62             sub get_users {
63             my ($self, $nameregex) = @_;
64              
65             my $new = Net::OpenNebula::User->new(rpc => $self);
66             return $new->_get_instances($nameregex);
67             }
68              
69             sub get_groups {
70             my ($self, $nameregex) = @_;
71              
72             my $new = Net::OpenNebula::Group->new(rpc => $self);
73             return $new->_get_instances($nameregex);
74             }
75              
76             sub get_hosts {
77             my ($self, $nameregex) = @_;
78              
79             my $new = Net::OpenNebula::Host->new(rpc => $self);
80             return $new->_get_instances($nameregex);
81             }
82              
83             sub get_host {
84             my ($self, $id) = @_;
85              
86             if(! defined $id) {
87             my $msg = "You have to define the ID => Usage: \$obj->get_host(\$host_id)";
88              
89             $self->error($msg);
90             if( $self->{fail_on_rpc_fail}) {
91             die($msg);
92             } else {
93             return;
94             }
95             }
96              
97             my $data = $self->_rpc("one.host.info", [ int => $id ]);
98             return Net::OpenNebula::Host->new(rpc => $self, data => $data, extended_data => $data);
99             }
100              
101             sub get_vms {
102             my ($self, $nameregex) = @_;
103              
104             my $new = Net::OpenNebula::VM->new(rpc => $self);
105             return $new->_get_instances($nameregex,
106             [ int => -2 ], # always get all resources
107             [ int => -1 ], # range from (begin)
108             [ int => -1 ], # range to (end)
109             [ int => -1 ], # all states, except DONE
110             );
111             }
112              
113             sub get_vm {
114             my ($self, $id) = @_;
115              
116             if(! defined $id) {
117             my $msg = "You have to define the ID => Usage: \$obj->\$obj->get_vm(\$vm_id)";
118              
119             $self->error($msg);
120             if( $self->{fail_on_rpc_fail}) {
121             die($msg);
122             } else {
123             return;
124             }
125             }
126              
127             if($id =~ m/^\d+$/) {
128             my $data = $self->_rpc("one.vm.info", [ int => $id ]);
129             return Net::OpenNebula::VM->new(rpc => $self, data => $data, extended_data => $data);
130             }
131             else {
132             # try to find vm by name
133             my ($vm) = grep { $_->name eq $id } $self->get_vms;
134             return $vm;
135             }
136              
137             }
138              
139              
140             sub get_templates {
141             my ($self, $nameregex) = @_;
142              
143             my $new = Net::OpenNebula::Template->new(rpc => $self);
144             return $new->_get_instances($nameregex,
145             [ int => -2 ], # all templates
146             [ int => -1 ], # range start
147             [ int => -1 ], # range end
148             );
149             }
150              
151             sub get_vnets {
152             my ($self, $nameregex) = @_;
153              
154             my $new = Net::OpenNebula::VNet->new(rpc => $self);
155             return $new->_get_instances($nameregex,
156             [ int => -2 ], # all VNets
157             [ int => -1 ], # range start
158             [ int => -1 ], # range end
159             );
160             }
161              
162             sub get_images {
163             my ($self, $nameregex) = @_;
164              
165             my $new = Net::OpenNebula::Image->new(rpc => $self);
166             return $new->_get_instances($nameregex,
167             [ int => -2 ], # all templates
168             [ int => -1 ], # range start
169             [ int => -1 ], # range end
170             );
171             }
172              
173             sub create_vm {
174             my ($self, %option) = @_;
175              
176             my $template;
177              
178             if($option{template} =~ m/^\d+$/) {
179             ($template) = grep { $_->id == $option{template} } $self->get_templates;
180             }
181             else {
182             ($template) = grep { $_->name eq $option{template} } $self->get_templates;
183             }
184              
185             my $hash_ref = $template->get_template_ref;
186             $hash_ref->{TEMPLATE}->[0]->{NAME}->[0] = $option{name};
187              
188             my $s = XMLout($hash_ref, RootName => undef, NoIndent => 1 );
189              
190             my $id = $self->_rpc("one.vm.allocate", [ string => $s ]);
191              
192             if(! defined($id)) {
193             $self->error("Create vm failed");
194             return;
195             }
196              
197             return $self->get_vm($id);
198             }
199              
200             sub create_host {
201             my ($self, %option) = @_;
202              
203             my @args = (
204             "one.host.allocate",
205             [ string => $option{name} ],
206             [ string => $option{im_mad} ],
207             [ string => $option{vmm_mad} ],
208             );
209              
210             if ($self->version() < version->new('5.0.0')) {
211             push(@args, [ string => $option{vnm_mad} ]);
212             };
213             push(@args, [ int => (exists $option{cluster} ? $option{cluster} : -1) ]);
214              
215             my $id = $self->_rpc(@args);
216              
217             if(! defined($id)) {
218             $self->error("Create host failed");
219             return;
220             }
221              
222             return $self->get_host($id);
223             }
224              
225              
226             sub create_datastore {
227             my ($self, $txt) = @_;
228              
229             my $new = Net::OpenNebula::Datastore->new(rpc => $self, data => undef);
230             $new->create($txt);
231              
232             return $new;
233             }
234              
235             sub create_user {
236             my ($self, $name, $password, $driver) = @_;
237              
238             my $new = Net::OpenNebula::User->new(rpc => $self, data => undef);
239             $new->create($name, $password, $driver);
240              
241             return $new;
242             }
243              
244             sub create_group {
245             my ($self, $name) = @_;
246              
247             my $new = Net::OpenNebula::Group->new(rpc => $self, data => undef);
248             $new->create($name);
249              
250             return $new;
251             }
252              
253             sub create_template {
254             my ($self, $txt) = @_;
255              
256             my $new = Net::OpenNebula::Template->new(rpc => $self, data => undef);
257             $new->create($txt);
258              
259             return $new;
260             }
261              
262              
263             sub create_vnet {
264             my ($self, $txt) = @_;
265              
266             my $new = Net::OpenNebula::VNet->new(rpc => $self, data => undef);
267             $new->create($txt);
268              
269             return $new;
270             }
271              
272              
273             sub create_image {
274             my ($self, $txt, $datastore) = @_;
275              
276             my $datastoreid;
277             if($datastore =~ m/^\d+$/) {
278             $datastoreid = $datastore;
279             }
280             else {
281             my @datastores = $self->get_datastores(qr{^$datastore$});
282             $datastoreid = $datastores[0]->id if (@datastores); # take the first one
283             }
284              
285             my $new = Net::OpenNebula::Image->new(rpc => $self, data => undef);
286             $new->create($txt, $datastoreid);
287              
288             return $new;
289             }
290              
291             1;