File Coverage

blib/lib/Ovirt/VM.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             package Ovirt::VM;
2              
3 1     1   3629 use v5.10;
  1         3  
  1         43  
4 1     1   4 use LWP::UserAgent;
  1         2  
  1         16  
5 1     1   289 use XML::LibXML;
  0            
  0            
6             use Carp;
7             use Moo;
8              
9             with 'Ovirt';
10             our $VERSION = '0.03';
11              
12             =head1 NAME
13              
14             Ovirt::VM - Bindings for oVirt VM API
15              
16             =head1 VERSION
17              
18             Version 0.03
19              
20             =cut
21              
22             =head1 SYNOPSIS
23              
24             use Ovirt::VM;
25              
26             my %con = (
27             username => 'admin',
28             password => 'password',
29             manager => 'ovirt-mgr.example.com',
30             vm_output_attrs => 'id,name,state,description', # optional
31             vm_output_delimiter => '||', # optional
32             );
33              
34             my $vm = Ovirt::VM->new(%con);
35              
36             # return xml output
37             print $vm->list_xml;
38            
39             # list vm separated by new line
40             # return attributes specified on 'vm_output_attrs'
41             print $vm->list;
42            
43             # list specific vm
44             print $vm->list('b4738b0f-b73d-4a66-baa8-2ba465d63132');
45            
46             # create, remove, get all running vm, stop all vm
47             $vm->create('vm1','Default','CentOS7');
48             $vm->remove('2d83bb51-9a77-432d-939c-35be207017b9');
49             $vm->get_running();
50             $vm->stop_all();
51            
52             # start, stop, reboot, migrate vm
53             $vm->start ('b4738b0f-b73d-4a66-baa8-2ba465d63132');
54             $vm->stop ('b4738b0f-b73d-4a66-baa8-2ba465d63132');
55             $vm->reboot ('b4738b0f-b73d-4a66-baa8-2ba465d63132');
56             $vm->migrate ('b4738b0f-b73d-4a66-baa8-2ba465d63132');
57              
58             # get vm's statistics
59             $vm->get_statistics($vmid);
60            
61             # add/remove/list nic and disk
62             $vm->add_disk('6efc0cfa-8495-4a96-93e5-ee490328cf48', # vm id
63             'virtio', # driver interface
64             'cow', # format
65             '1073741824', # size
66             'mydisk1', # disk name
67             '9b952bdc-b7ec-4673-84b0-477b48945a9a' # storage domain id
68             );
69              
70             $vm->add_nic('6efc0cfa-8495-4a96-93e5-ee490328cf48', # vm id
71             'virtio', # driver interface
72             'nic1', # nic name
73             'rhevm' # network name
74             );
75              
76             # Output also available in hash
77             # for example to print all vm name and state
78             my $hash = $vm->hash_output;
79             for my $array (keys $hash->{vm}) {
80             print $hash->{vm}[$array]->{name} . " " .
81             $hash->{vm}[$array]->{status}->{state};
82             }
83            
84             # we can also specify specific vm 'id' when initiating an object
85             # so we can direct access the element for specific vm
86             print $vm->hash_output->{name};
87             print $vm->hash_output->{cluster}->{id};
88              
89             =head1 Attributes
90              
91             Other attributes is also inherited from Ovirt.pm
92             Check 'perldoc Ovirt' for detail
93            
94             notes :
95             ro = read only, can be specified only during initialization
96             rw = read write, user can set this attribute
97             rwp = read write protected, for internal class
98            
99             vm_url = (ro) store default vm url path
100             vm_cdrom_xml = (ro) store xml to be post on start/stop vm action with boot device set to cdrom
101             vm_hd_xml = (ro) store xml to be post on start/stop vm action with boot device set to hd
102             vm_boot_dev = (rw) set boot device when start / stopping vm, default to hd
103             vm_output_delimiter = (rw) specify output delimiter between attribute, default is '||'
104             vm_output_attrs = (rw) store vm attributes to be returned, default is (id, name, state)
105             supported attributes :
106             id name
107             memory description
108             state cpu_cores
109             cpu_sockets cpu_arch
110             cpu_shares os_type
111             boot_dev ha_enabled
112             ha_priority display_type
113             display_address display_port
114             cluster_id template_id
115             stop_time creation_time
116             timezone usb_enabled
117             host_id display_host_subject
118            
119             =cut
120              
121             has 'vm_url' => ( is => 'ro', default => '/api/vms' );
122             has 'vm_output_attrs' => ( is => 'rw', default => 'id,name,state',
123             isa => sub {
124             # store all output attribute into array split by ','
125             # $_[0] is the arguments spefied during initialization
126             my @attrs = split ',' => $_[0];
127            
128             croak "vm_output_attrs can't be empty"
129             unless @attrs;
130            
131             # check if provided attribute is valid / supported
132             my @supported_attr = qw |
133             id name
134             memory description
135             state cpu_cores
136             cpu_sockets cpu_arch
137             cpu_shares os_type
138             boot_dev ha_enabled
139             ha_priority display_type
140             display_address display_port
141             cluster_id template_id
142             stop_time creation_time
143             timezone usb_enabled
144             host_id display_host_subject
145             |;
146             for my $attr (@attrs) {
147             $attr = lc ($attr);
148             $attr = Ovirt->trim($attr);
149             croak "Attribute $attr is not valid / supported"
150             unless grep { /\b$attr\b/ } @supported_attr;
151             }
152             });
153            
154             has 'vm_output_delimiter' => ( is => 'rw', default => '||' );
155             has 'vm_cdrom_xml' => ( is => 'ro', default => '');
156             has 'vm_hd_xml' => ( is => 'ro', default => '');
157             has 'vm_boot_dev' => ( is => 'rw',
158             isa => sub {
159             my $dev = $_[0];
160             $dev = lc ($dev);
161            
162             croak "supported boot device is hd or cdrom"
163             unless $dev =~ /^(hd|cdrom)/;
164             },
165             default => 'hd');
166              
167             =head1 SUBROUTINES/METHODS
168              
169             =head2 BUILD
170              
171             The Constructor, build logging, call pass_log_obj method
172             Built root_url with vm_url
173             set output with get_api_response method from Ovirt.pm
174             check if output attributes is valid
175             =cut
176              
177             sub BUILD {
178             my $self = shift;
179            
180             $self->pass_log_obj;
181            
182             if ($self->id) {
183             $self->_set_root_url($self->vm_url . '/' . $self->id);
184             }
185             else {
186             $self->_set_root_url($self->vm_url);
187             }
188            
189             $self->get_api_response();
190             }
191              
192             =head2 list_xml
193              
194             return xml output
195             =cut
196              
197             sub list_xml {
198             my $self = shift;
199            
200             return $self->xml_output;
201             }
202              
203             =head2 vm_action_output
204              
205             this method handle the output e.g start / stop vm
206             required arguments ($xml), output passed by start/stop method
207             =cut
208              
209             sub vm_action_output {
210             my $self = shift;
211            
212             # xml output from action (start,stop,reboot, etc)
213             my $xml = shift;
214            
215             $self->log->debug($xml);
216            
217             return $xml;
218             }
219              
220             =head2 remove
221              
222             remove vm
223              
224             =cut
225              
226             sub remove {
227             my $self = shift;
228            
229             my $vmid = shift || undef;
230             my $move_url;
231            
232             # set the move final url
233             if ($self->id) {
234             $move_url = $self->url;
235             }
236             else {
237             if ($vmid) {
238             my $is_valid = $self->is_vmid_valid($vmid);
239             croak "vm id not found" unless $is_valid;
240            
241             $move_url = $self->url . "/$vmid";
242             }
243             else {
244             croak "vm id is required";
245             }
246             }
247            
248             $self->log->debug("move action url = $move_url");
249            
250             # set user agent
251             my $ua = LWP::UserAgent->new();
252             my $action = $ua->delete($move_url);
253            
254             my $parser = XML::LibXML->new();
255             my $output = $parser->parse_string($action->decoded_content);
256            
257             $self->vm_action_output($output);
258             }
259              
260             =head2 list_disk
261              
262             list vm's disk
263             required argument ('vm id')
264              
265             =cut
266              
267             sub list_disk {
268             my $self = shift;
269             my $vmid = shift || undef;
270            
271             my $disk_url;
272            
273             # don't proceed if vm not exist
274             my $is_valid = $self->is_vmid_valid($vmid);
275             croak "vm id not found"
276             unless $is_valid;
277            
278             # set the url
279             $disk_url = $self->url . "/$vmid/disks";
280            
281             my $ua = LWP::UserAgent->new();
282             my $tx = $ua->get($disk_url);
283            
284             my $parser = XML::LibXML->new();
285             my $output = $parser->parse_string($tx->decoded_content);
286            
287             $self->log->debug($output);
288            
289             return $output;
290             }
291              
292             =head2 add_disk
293              
294             create vm disk
295             required arguments ('vm id', 'driver type', 'format' , 'size in bytes', 'disk name', 'storage domain id' )
296            
297             supported driver type :
298             - virtio
299             - ide
300            
301             supported format:
302             - cow
303             - raw
304            
305             use Ovirt::Storage to get more information for the storage domain id
306             see 'perldoc Ovirt::Storage' for example
307            
308             example :
309             $vm->add_disk('6efc0cfa-8495-4a96-93e5-ee490328cf48', # vm id
310             'virtio', # driver interface
311             'cow', # format
312             '1073741824', # size
313             'mydisk1', # disk name
314             '9b952bdc-b7ec-4673-84b0-477b48945a9a' # storage domain id
315             );
316              
317             =cut
318              
319             sub add_disk {
320             my $self = shift;
321            
322             my ($vmid, $driver, $format, $size, $disk_name, $storage_domain_id) = @_;
323            
324             my $disk_url;
325            
326             # don't proceed if vm not exist
327             my $is_valid = $self->is_vmid_valid($vmid);
328             croak "vm id not found"
329             unless $is_valid;
330            
331             # set the url to be post
332             $disk_url = $self->url . "/$vmid/disks";
333            
334             croak "driver type not supported, use virtio/e1000/rtl8139."
335             unless $driver =~ /\b(virtio|ide)\b/;
336            
337             croak "disk format required"
338             unless $format;
339            
340             croak "disk size required"
341             unless $size;
342            
343             croak "disk name required"
344             unless $disk_name;
345            
346             croak "storage domain id required"
347             unless $storage_domain_id;
348            
349             # set xml string to be post
350             my $xml = <
351            
352             $disk_name
353            
354            
355            
356             $size
357             $driver
358             $format
359             false
360            
361             EOF
362            
363             $self->log->debug($xml);
364            
365             # set user agent
366             my $ua = LWP::UserAgent->new();
367             my $action = $ua->post($disk_url, Content_Type => 'application/xml', Content => $xml);
368            
369             my $parser = XML::LibXML->new();
370             my $output = $parser->parse_string($action->decoded_content);
371            
372             $self->log->debug($output);
373            
374             return $output;
375             }
376              
377             =head2 remove_disk
378              
379             remove vm disk
380             required arguments ('vm id', 'disk id')
381             use method list_disk to get the 'disk id' for particular vm
382            
383             example :
384             $vm->remove_disk('6efc0cfa-8495-4a96-93e5-ee490328cf48', '99a4f585-9a39-465b-ae24-0068bd4eaad6');
385            
386             =cut
387              
388             sub remove_disk {
389             my $self = shift;
390            
391             my ($vmid, $disk_id) = @_;
392            
393             my $disk_url;
394            
395             # don't proceed if vm not exist
396             my $is_valid = $self->is_vmid_valid($vmid);
397             croak "vm id not found"
398             unless $is_valid;
399            
400             # set the url to be post
401             $disk_url = $self->url . "/$vmid/disks/$disk_id";
402            
403             croak "disk id required"
404             unless $disk_id;
405            
406             $self->log->debug("move action url = $disk_url");
407            
408             # set user agent
409             my $ua = LWP::UserAgent->new();
410             my $action = $ua->delete($disk_url);
411            
412             my $parser = XML::LibXML->new();
413             my $output = $parser->parse_string($action->decoded_content);
414            
415             $self->vm_action_output($output);
416             }
417              
418             =head2 list_nic
419              
420             list vm's nic
421             required argument ('vm id')
422              
423             =cut
424              
425             sub list_nic {
426             my $self = shift;
427             my $vmid = shift || undef;
428            
429             my $nic_url;
430            
431             # don't proceed if vm not exist
432             my $is_valid = $self->is_vmid_valid($vmid);
433             croak "vm id not found"
434             unless $is_valid;
435            
436             # set the url
437             $nic_url = $self->url . "/$vmid/nics";
438            
439             my $ua = LWP::UserAgent->new();
440             my $tx = $ua->get($nic_url);
441            
442             my $parser = XML::LibXML->new();
443             my $output = $parser->parse_string($tx->decoded_content);
444            
445             $self->log->debug($output);
446            
447             return $output;
448             }
449              
450             =head2 add_nic
451              
452             create vm nic
453             required arguments ('vm id', 'driver type', 'nic name', 'network name' )
454            
455             supported driver type :
456             - virtio
457             - e1000
458             - rtl8139
459            
460             use Ovirt::Network to get more information for the network name
461             see 'perldoc Ovirt::Network' for example
462            
463             example :
464             $vm->add_nic('6efc0cfa-8495-4a96-93e5-ee490328cf48', 'virtio', 'nic1', 'rhevm');
465              
466             =cut
467              
468             sub add_nic {
469             my $self = shift;
470            
471             my ($vmid, $driver, $nic_name, $network_name) = @_;
472            
473             my $nic_url;
474            
475             # don't proceed if vm not exist
476             my $is_valid = $self->is_vmid_valid($vmid);
477             croak "vm id not found"
478             unless $is_valid;
479            
480             # set the url to be post
481             $nic_url = $self->url . "/$vmid/nics";
482            
483             croak "driver type not supported, use virtio/e1000/rtl8139."
484             unless $driver =~ /\b(virtio|e1000|rtl8139)\b/;
485            
486             croak "nic name required"
487             unless $nic_name;
488            
489             croak "network name required"
490             unless $network_name;
491            
492             # set xml string to be post
493             my $xml = <
494            
495             $driver
496             $nic_name
497            
498             $network_name
499            
500            
501             EOF
502            
503             $self->log->debug($xml);
504            
505             # set user agent
506             my $ua = LWP::UserAgent->new();
507             my $action = $ua->post($nic_url, Content_Type => 'application/xml', Content => $xml);
508            
509             my $parser = XML::LibXML->new();
510             my $output = $parser->parse_string($action->decoded_content);
511            
512             $self->log->debug($output);
513            
514             return $output;
515             }
516              
517             =head2 remove_nic
518              
519             remove vm nic
520             required arguments ('vm id', 'nic id')
521             use method list_nic to get the 'nic id' for particular vm
522            
523             example :
524             $vm->remove_nic('6efc0cfa-8495-4a96-93e5-ee490328cf48', '82416c65-d8b2-4c82-8134-0e73e5ead624');
525            
526             =cut
527              
528             sub remove_nic {
529             my $self = shift;
530            
531             my ($vmid, $nic_id) = @_;
532            
533             my $nic_url;
534            
535             # don't proceed if vm not exist
536             my $is_valid = $self->is_vmid_valid($vmid);
537             croak "vm id not found"
538             unless $is_valid;
539            
540             # set the url to be post
541             $nic_url = $self->url . "/$vmid/nics/$nic_id";
542            
543             croak "nic id required"
544             unless $nic_id;
545            
546             $self->log->debug("move action url = $nic_url");
547            
548             # set user agent
549             my $ua = LWP::UserAgent->new();
550             my $action = $ua->delete($nic_url);
551            
552             my $parser = XML::LibXML->new();
553             my $output = $parser->parse_string($action->decoded_content);
554            
555             $self->vm_action_output($output);
556             }
557              
558             =head2 create
559              
560             create vm using template
561             required arguments (vm name, cluster name, template name)
562             optional argument 'memory in bytes'
563             example :
564             # with memory specified
565             $vm->create('vm1', 'production_cluster', 'RHEL7', 1073741824);
566            
567             # without memory specified (will be based on template's memory)
568             $vm->create('vm1', 'production_cluster', 'RHEL7');
569            
570             =cut
571              
572             sub create {
573             my $self = shift;
574            
575             my ($vm_name, $cluster_name, $template_name, $memory) = @_;
576             croak "vm name required" unless $vm_name;
577             croak "cluster name required" unless $cluster_name;
578             croak "template name required" unless $template_name;
579            
580             $vm_name = $self->trim($vm_name);
581             $cluster_name = $self->trim($cluster_name);
582             $template_name = $self->trim($template_name);
583            
584             $self->log->debug("vm name = $vm_name");
585             $self->log->debug("cluster name = $cluster_name");
586             $self->log->debug("template name = $template_name");
587            
588             # create xml to be post
589             my $xml;
590            
591             if ($memory) {
592             $memory = $self->trim($memory);
593             croak "Memory did not look like number" unless $memory =~ /^\d+$/;
594            
595             $self->log->debug("memory = $memory");
596            
597             $xml = <
598            
599             $vm_name
600            
601             $cluster_name
602            
603            
606             $memory
607            
608            
609            
610            
611             EOF
612              
613             }
614             else {
615             $self->log->debug("memory not specified");
616             $xml = <
617            
618             $vm_name
619            
620             $cluster_name
621            
622            
625            
626            
627            
628            
629             EOF
630             }
631            
632             $self->log->debug($xml);
633            
634             my $create_url = $self->base_url . $self->vm_url;
635             $self->log->debug("create url = $create_url");
636            
637             # set user agent
638             my $ua = LWP::UserAgent->new();
639             my $action = $ua->post($create_url, Content_Type => 'application/xml', Content => $xml);
640            
641             my $parser = XML::LibXML->new();
642             my $output = $parser->parse_string($action->decoded_content);
643            
644             $self->log->debug($output);
645            
646             return $output;
647             }
648              
649             =head2 start
650              
651             start vm
652             required arguments ($vmid)
653             if $self->id is set during initialization, argument is not required
654             =cut
655              
656             sub start {
657             my $self = shift;
658            
659             my $vmid = shift || undef;
660             my $start_url;
661            
662             # set the start final url
663             if ($self->id) {
664             $start_url = $self->url . "/start";
665             }
666             else {
667             if ($vmid) {
668             my $is_valid = $self->is_vmid_valid($vmid);
669             croak "vm id not found" unless $is_valid;
670            
671             $start_url = $self->url . "/$vmid/start";
672             }
673             else {
674             croak "vm id is required";
675             }
676             }
677            
678             $self->log->debug("start action url = $start_url");
679            
680             # set user agent
681             my $ua = LWP::UserAgent->new();
682             my $action;
683            
684             if ($self->vm_boot_dev eq 'hd') {
685             $action = $ua->post($start_url, Content_Type => 'application/xml', Content => $self->vm_hd_xml);
686             }
687             else {
688             $action = $ua->post($start_url, Content_Type => 'application/xml', Content => $self->vm_cdrom_xml);
689             }
690            
691             my $parser = XML::LibXML->new();
692             my $output = $parser->parse_string($action->decoded_content);
693            
694             $self->vm_action_output($output);
695             }
696              
697             =head2 stop
698              
699             stop vm
700             required arguments ($vmid)
701             if $self->id is set during initialization, argument is not required
702             =cut
703              
704             sub stop {
705             my $self = shift;
706            
707             my $vmid = shift || undef;
708             my $stop_url;
709            
710             # set the stop final url
711             if ($self->id) {
712             $stop_url = $self->url . "/stop";
713             }
714             else {
715             if ($vmid) {
716             my $is_valid = $self->is_vmid_valid($vmid);
717             croak "vm id not found" unless $is_valid;
718             $stop_url = $self->url . "/$vmid/stop";
719             }
720             else {
721             croak "vm id is required";
722             }
723             }
724            
725             $self->log->debug("stop action url = $stop_url");
726            
727             # set user agent
728             my $ua = LWP::UserAgent->new();
729             my $action;
730            
731             if ($self->vm_boot_dev eq 'hd') {
732             $action = $ua->post($stop_url, Content_Type => 'application/xml', Content => $self->vm_hd_xml);
733             }
734             else {
735             $action = $ua->post($stop_url, Content_Type => 'application/xml', Content => $self->vm_cdrom_xml);
736             }
737            
738             my $parser = XML::LibXML->new();
739             my $output = $parser->parse_string($action->decoded_content);
740            
741             $self->vm_action_output($output);
742             }
743              
744             =head2 stop_all
745              
746             stop all vm if vm state = 'up'
747             do not set 'id' during initialization because it will not return all vm
748             this will loop using stop method
749             $vm->stop_all();
750            
751             =cut
752              
753             sub stop_all {
754             my $self = shift;
755            
756             # croak if id is defined because it will not return all vm
757             croak "Don't set id during initialization since it will not return all vm"
758             if $self->id;
759            
760             my $running_vms = $self->get_running();
761            
762             if ($running_vms) {
763             my @vms = split '\n' => $running_vms;
764            
765             for my $vm (@vms) {
766             $self->log->debug($vm);
767             my @vmid = split ',' => $vm;
768             $self->stop($vmid[0]);
769             }
770             }
771             else {
772             print "no vm in up state\n";
773             exit;
774             }
775             }
776              
777             =head2 get_running
778              
779             return vmid,name if state = 'up'
780             each vm separated by new line
781             do not set 'id' during initialization because it will not return all vm
782             $vm->get_running();
783            
784             =cut
785              
786             sub get_running {
787             my $self = shift;
788            
789             # store the output and return it at the end
790             my $output;
791            
792             # store id, name to array to be looped
793             my @attrs = qw |id name|;
794            
795             # store the last element to escape the vm_output_delimeter
796             my $last_element = pop (@attrs);
797             $self->log->debug("last element = $last_element");
798            
799             for my $element_id ( 0 .. $#{ $self->hash_output->{vm} } ) {
800             # check the state first, if up, proceed
801             $self->log->debug("requesting vm state for element $element_id");
802            
803             if (my $state = $self->get_vm_by_element_id($element_id, 'state') || $self->not_available) {
804            
805             if ($state ne 'up') {
806             $self->log->debug("not interested, vm state is = " . $state);
807            
808             # not interested if vm is not up, go to next loop
809             next;
810             }
811             }
812            
813             # in case there's no any element left, the last element become the only attribute requested
814             if (@attrs) {
815             for my $attr (@attrs) {
816            
817             $self->log->debug("requesting attribute $attr for element $element_id");
818              
819             my $attr_output = $self->get_vm_by_element_id($element_id, $attr) || $self->not_available;
820             $output .= $attr_output . ',';
821             $self->log->debug("output for attribute $attr element $element_id = " . $attr_output);
822             }
823             }
824            
825             #handle last element
826             $self->log->debug("requesting attribute $last_element for element $element_id");
827            
828             if (my $last_output = $self->get_vm_by_element_id($element_id, $last_element) || $self->not_available) {
829             $output .= $last_output . "\n";
830             $self->log->debug("output for attribute $last_element element $element_id = " . $last_output);
831             }
832            
833             #$output .= "\n";
834             }
835            
836             return $output;
837             }
838              
839             =head2 reboot
840              
841             reboot vm
842             required arguments ($vmid)
843             if $self->id is set during initialization, argument is not required
844             =cut
845              
846             sub reboot {
847             my $self = shift;
848            
849             my $vmid = shift || undef;
850             my $reboot_url;
851            
852             # set the reboot final url
853             if ($self->id) {
854             $reboot_url = $self->url . "/reboot";
855             }
856             else {
857             if ($vmid) {
858             my $is_valid = $self->is_vmid_valid($vmid);
859             croak "vm id not found" unless $is_valid;
860            
861             $reboot_url = $self->url . "/$vmid/reboot";
862             }
863             else {
864             croak "vm id is required";
865             }
866             }
867            
868             $self->log->debug("reboot action url = $reboot_url");
869            
870             # set user agent
871             my $ua = LWP::UserAgent->new();
872             my $action;
873            
874             if ($self->vm_boot_dev eq 'hd') {
875             $action = $ua->post($reboot_url, Content_Type => 'application/xml', Content => $self->vm_hd_xml);
876             }
877             else {
878             $action = $ua->post($reboot_url, Content_Type => 'application/xml', Content => $self->vm_cdrom_xml);
879             }
880            
881             my $parser = XML::LibXML->new();
882             my $output = $parser->parse_string($action->decoded_content);
883            
884             $self->vm_action_output($output);
885             }
886              
887             =head2 suspend
888              
889             suspend vm
890             required arguments ($vmid)
891             if $self->id is set during initialization, argument is not required
892             =cut
893              
894             sub suspend {
895             my $self = shift;
896            
897             my $vmid = shift || undef;
898             my $suspend_url;
899            
900             # set the suspend final url
901             if ($self->id) {
902             $suspend_url = $self->url . "/suspend";
903             }
904             else {
905             if ($vmid) {
906             my $is_valid = $self->is_vmid_valid($vmid);
907             croak "vm id not found" unless $is_valid;
908            
909             $suspend_url = $self->url . "/$vmid/suspend";
910             }
911             else {
912             croak "vm id is required";
913             }
914             }
915            
916             $self->log->debug("suspend action url = $suspend_url");
917            
918             # set user agent
919             my $ua = LWP::UserAgent->new();
920             my $action;
921            
922             if ($self->vm_boot_dev eq 'hd') {
923             $action = $ua->post($suspend_url, Content_Type => 'application/xml', Content => $self->vm_hd_xml);
924             }
925             else {
926             $action = $ua->post($suspend_url, Content_Type => 'application/xml', Content => $self->vm_cdrom_xml);
927             }
928            
929             my $parser = XML::LibXML->new();
930             my $output = $parser->parse_string($action->decoded_content);
931            
932             $self->vm_action_output($output);
933             }
934              
935             =head2 migrate
936              
937             migrate vm
938             required arguments ($vmid)
939             if $self->id is set during initialization, argument is not required
940             =cut
941              
942             sub migrate {
943             my $self = shift;
944            
945             my $vmid = shift || undef;
946             my $migrate_url;
947            
948             # set the migrate final url
949             if ($self->id) {
950             $migrate_url = $self->url . "/migrate";
951             }
952             else {
953             if ($vmid) {
954             my $is_valid = $self->is_vmid_valid($vmid);
955             croak "vm id not found" unless $is_valid;
956            
957             $migrate_url = $self->url . "/$vmid/migrate";
958             }
959             else {
960             croak "vm id is required";
961             }
962             }
963            
964             $self->log->debug("migrate action url = $migrate_url");
965            
966             # set user agent
967             my $ua = LWP::UserAgent->new();
968             my $action;
969            
970             if ($self->vm_boot_dev eq 'hd') {
971             $action = $ua->post($migrate_url, Content_Type => 'application/xml', Content => $self->vm_hd_xml);
972             }
973             else {
974             $action = $ua->post($migrate_url, Content_Type => 'application/xml', Content => $self->vm_cdrom_xml);
975             }
976            
977             my $parser = XML::LibXML->new();
978             my $output = $parser->parse_string($action->decoded_content);
979            
980             $self->vm_action_output($output);
981             }
982              
983             =head2 is_vmid_valid
984              
985             return false if vmid not valid
986             =cut
987              
988             sub is_vmid_valid {
989             my $self = shift;
990             my $vmid = shift;
991            
992             croak "vm id required" unless $vmid;
993            
994             $vmid = $self->trim($vmid);
995             $self->log->debug("vm id = $vmid");
996            
997             # if vm id match, return 1
998             for my $element_id (0 .. $#{ $self->hash_output->{vm} }) {
999             if ($self->hash_output->{vm}[$element_id]->{id} eq $vmid) {
1000             $self->log->debug("$vmid is valid");
1001             return 1;
1002             }
1003             }
1004            
1005             $self->log->debug("$vmid is not valid");
1006             return 0;
1007             }
1008              
1009             =head2 get_statistics
1010              
1011             required argument ($vmid) or set 'id' during initialization
1012             return vm statistics
1013             $vm->get_statistics($vmid);
1014              
1015             =cut
1016              
1017             sub get_statistics {
1018             my $self = shift;
1019             my $vmid = $self->id || shift || die "vm id required\n";
1020            
1021             my $url = $self->base_url . $self->vm_url . '/' . $vmid . '/statistics';
1022             my $ua = LWP::UserAgent->new();
1023            
1024             $self->log->debug($url);
1025             my $tx = $ua->get($url);
1026            
1027             my $output;
1028            
1029             if ($tx->is_success) {
1030            
1031             local $XML::LibXML::skipXMLDeclaration = 1;
1032             my $parser = XML::LibXML->new();
1033             $output = $parser->parse_string($tx->decoded_content);
1034             }
1035             else {
1036             my $err = $tx->status_line;
1037             $self->log->debug("LWP Error : " . $err);
1038             $self->log->debug("LWP Decoded Content :" . $tx->decoded_content);
1039            
1040             croak "LWP Status line : " . $err;
1041             croak "LWP Decoded Content :" . $tx->decoded_content;
1042             }
1043            
1044             return $output;
1045             }
1046              
1047             =head2 list
1048            
1049             return vm's attributes text output from hash_output attribute
1050             if no argument spesified, it will return all vm attributes (based on vm_output_attrs)
1051             argument supported is 'vm id'
1052             example :
1053             $vm->list('b4738b0f-b73d-4a66-baa8-2ba465d63132');
1054            
1055             =cut
1056              
1057             sub list {
1058             my $self = shift;
1059            
1060             my $vmid = shift || undef;
1061            
1062             # store the output and return it at the end
1063             my $output;
1064            
1065             # store each attribute to array to be looped
1066             my @attrs = split ',' => $self->vm_output_attrs;
1067            
1068             # store the last element to escape the vm_output_delimeter
1069             my $last_element = pop (@attrs);
1070             $self->log->debug("last element = $last_element");
1071              
1072             # if the id is defined during initialization
1073             # the rest api output will only contain attributes for this id
1074             # so it's not necessary to loop on vm element
1075             if ($self->id) {
1076             for my $attr (@attrs) {
1077             $self->log->debug("requesting attribute $attr");
1078            
1079             my $attr_output = $self->get_vm_by_self_id($attr) || $self->not_available;
1080             $output .= $attr_output . $self->vm_output_delimiter;
1081             $self->log->debug("output for attribute $attr = " . $attr_output);
1082             }
1083            
1084             #handle last element or the only element
1085             $self->log->debug("requesting attribute $last_element");
1086            
1087             if (my $last_output = $self->get_vm_by_self_id($last_element) || $self->not_available) {
1088             $output .= $last_output;
1089             $self->log->debug("output for attribute $last_element = " . $last_output);
1090             }
1091            
1092             $output .= "\n";
1093             }
1094             elsif ($vmid) {
1095             #store vmid element
1096             my $vmid_element;
1097            
1098             $vmid = $self->trim($vmid);
1099            
1100             # store hash to avoid keys on reference
1101             #my %hash = $self->hash_output->{vm};
1102            
1103             for my $element_id ( 0 .. $#{ $self->hash_output->{vm} } ) {
1104             next unless
1105             $self->hash_output->{vm}[$element_id]->{id} eq $vmid;
1106            
1107             $vmid_element = $element_id;
1108             }
1109            
1110             croak "vm id not found" unless $vmid_element >= 0;
1111            
1112             for my $attr (@attrs) {
1113             $self->log->debug("requesting attribute $attr for element $vmid_element");
1114            
1115             my $attr_output = $self->get_vm_by_element_id($vmid_element, $attr) || $self->not_available;
1116             $output .= $attr_output . $self->vm_output_delimiter;
1117             $self->log->debug("output for attribute $attr element $vmid_element = " . $attr_output);
1118             }
1119            
1120             #handle last element or the only element
1121             $self->log->debug("requesting attribute $last_element for element $vmid_element");
1122            
1123             if (my $last_output = $self->get_vm_by_element_id($vmid_element, $last_element) || $self->not_available) {
1124             $output .= $last_output;
1125             $self->log->debug("output for attribute $last_element element $vmid_element = " . $last_output);
1126             }
1127            
1128             $output .= "\n";
1129             }
1130             else {
1131            
1132             for my $element_id ( 0 .. $#{ $self->hash_output->{vm} } ) {
1133            
1134             # in case there's no any element left, the last element become the only attribute requested
1135             if (@attrs) {
1136             for my $attr (@attrs) {
1137            
1138             $self->log->debug("requesting attribute $attr for element $element_id");
1139            
1140             my $attr_output = $self->get_vm_by_element_id($element_id, $attr) || $self->not_available;
1141             $output .= $attr_output . $self->vm_output_delimiter;
1142             $self->log->debug("output for attribute $attr element $element_id = " . $attr_output);
1143             }
1144             }
1145            
1146             #handle last element or the only element
1147             $self->log->debug("requesting attribute $last_element for element $element_id");
1148            
1149             if (my $last_output = $self->get_vm_by_element_id($element_id, $last_element) || $self->not_available) {
1150             $output .= $last_output;
1151             $self->log->debug("output for attribute $last_element element $element_id = " . $last_output);
1152             }
1153            
1154             $output .= "\n";
1155             }
1156             }
1157            
1158             return $output;
1159             }
1160              
1161             =head2 get_vm_by_element_id
1162            
1163             This method is used by list method to list all vm attribute requested
1164             An array element id and attribute name is required
1165             =cut
1166              
1167             sub get_vm_by_element_id {
1168             my $self = shift;
1169            
1170             my ($element_id, $attr) = @_;
1171            
1172             croak "hash output is not defined"
1173             unless $self->hash_output;
1174            
1175             $attr = $self->trim($attr);
1176             $self->log->debug("element id = $element_id, attribute = $attr");
1177            
1178             if ($attr eq 'id') {
1179             return $self->hash_output->{vm}[$element_id]->{id};
1180             }
1181             elsif ($attr eq 'name') {
1182             return $self->hash_output->{vm}[$element_id]->{name};
1183             }
1184             elsif ($attr eq 'memory') {
1185             return $self->hash_output->{vm}[$element_id]->{memory};
1186             }
1187             elsif ($attr eq 'state') {
1188             return $self->hash_output->{vm}[$element_id]->{status}->{state};
1189             }
1190             elsif ($attr eq 'description') {
1191             return $self->hash_output->{vm}[$element_id]->{description};
1192             }
1193             elsif ($attr eq 'cpu_cores') {
1194             return $self->hash_output->{vm}[$element_id]->{cpu}->{topology}->{cores};
1195             }
1196             elsif ($attr eq 'cpu_sockets') {
1197             return $self->hash_output->{vm}[$element_id]->{cpu}->{topology}->{sockets};
1198             }
1199             elsif ($attr eq 'cpu_arch') {
1200             return $self->hash_output->{vm}[$element_id]->{cpu}->{architecture};
1201             }
1202             elsif ($attr eq 'cpu_shares') {
1203             return $self->hash_output->{vm}[$element_id]->{cpu_shares};
1204             }
1205             elsif ($attr eq 'os_type') {
1206             return $self->hash_output->{vm}[$element_id]->{os}->{type};
1207             }
1208             elsif ($attr eq 'boot_dev') {
1209             return $self->hash_output->{vm}[$element_id]->{os}->{boot}->{dev};
1210             }
1211             elsif ($attr eq 'ha_enabled') {
1212             return $self->hash_output->{vm}[$element_id]->{high_availability}->{enabled};
1213             }
1214             elsif ($attr eq 'ha_priority') {
1215             return $self->hash_output->{vm}[$element_id]->{high_availability}->{priority};
1216             }
1217             elsif ($attr eq 'display_type') {
1218             return $self->hash_output->{vm}[$element_id]->{display}->{type};
1219             }
1220             elsif ($attr eq 'display_address') {
1221             return $self->hash_output->{vm}[$element_id]->{display}->{address};
1222             }
1223             elsif ($attr eq 'display_port') {
1224             # spice will return secure_port
1225             # vnc will return port
1226             return $self->hash_output->{vm}[$element_id]->{display}->{secure_port}
1227             if $self->hash_output->{vm}[$element_id]->{display}->{secure_port};
1228             return $self->hash_output->{vm}[$element_id]->{display}->{port}
1229             }
1230             elsif ($attr eq 'display_host_subject') {
1231             return $self->hash_output->{vm}[$element_id]->{display}->{certificate}->{subject};
1232             }
1233             elsif ($attr eq 'cluster_id') {
1234             return $self->hash_output->{vm}[$element_id]->{cluster}->{id};
1235             }
1236             elsif ($attr eq 'template_id') {
1237             return $self->hash_output->{vm}[$element_id]->{template}->{id};
1238             }
1239             elsif ($attr eq 'stop_time') {
1240             return $self->hash_output->{vm}[$element_id]->{stop_time};
1241             }
1242             elsif ($attr eq 'creation_time') {
1243             return $self->hash_output->{vm}[$element_id]->{creation_time};
1244             }
1245             elsif ($attr eq 'timezone') {
1246             return $self->hash_output->{vm}[$element_id]->{timezone};
1247             }
1248             elsif ($attr eq 'usb_enabled') {
1249             return $self->hash_output->{vm}[$element_id]->{usb}->{enabled};
1250             }
1251             elsif ($attr eq 'host_id') {
1252             return $self->hash_output->{vm}[$element_id]->{host}->{id};
1253             }
1254             }
1255              
1256             =head2 get_vm_by_self_id
1257            
1258             This method is used by list method if $self->id is defined
1259             The id is set during initialization (id => 'vmid')
1260             attribute name is required
1261             =cut
1262              
1263             sub get_vm_by_self_id {
1264             my $self = shift;
1265            
1266             my $attr = shift;
1267            
1268             croak "hash output is not defined"
1269             unless $self->hash_output;
1270            
1271             $attr = $self->trim($attr);
1272             $self->log->debug("attribute = $attr");
1273            
1274             if ($attr eq 'id') {
1275             return $self->hash_output->{id};
1276             }
1277             elsif ($attr eq 'name') {
1278             return $self->hash_output->{name};
1279             }
1280             elsif ($attr eq 'memory') {
1281             return $self->hash_output->{memory};
1282             }
1283             elsif ($attr eq 'state') {
1284             return $self->hash_output->{status}->{state};
1285             }
1286             elsif ($attr eq 'description') {
1287             return $self->hash_output->{description};
1288             }
1289             elsif ($attr eq 'cpu_cores') {
1290             return $self->hash_output->{cpu}->{topology}->{cores};
1291             }
1292             elsif ($attr eq 'cpu_sockets') {
1293             return $self->hash_output->{cpu}->{topology}->{sockets};
1294             }
1295             elsif ($attr eq 'cpu_arch') {
1296             return $self->hash_output->{cpu}->{architecture};
1297             }
1298             elsif ($attr eq 'cpu_shares') {
1299             return $self->hash_output->{cpu_shares};
1300             }
1301             elsif ($attr eq 'os_type') {
1302             return $self->hash_output->{os}->{type};
1303             }
1304             elsif ($attr eq 'boot_dev') {
1305             return $self->hash_output->{os}->{boot}->{dev};
1306             }
1307             elsif ($attr eq 'ha_enabled') {
1308             return $self->hash_output->{high_availability}->{enabled};
1309             }
1310             elsif ($attr eq 'ha_priority') {
1311             return $self->hash_output->{high_availability}->{priority};
1312             }
1313             elsif ($attr eq 'display_type') {
1314             return $self->hash_output->{display}->{type};
1315             }
1316             elsif ($attr eq 'display_address') {
1317             return $self->hash_output->{display}->{address};
1318             }
1319             elsif ($attr eq 'display_port') {
1320             # spice will return secure_port
1321             # vnc will return port
1322             return $self->hash_output->{display}->{secure_port}
1323             if $self->hash_output->{display}->{secure_port};
1324             return $self->hash_output->{display}->{port};
1325             }
1326             elsif ($attr eq 'display_host_subject') {
1327             return $self->hash_output->{display}->{certificate}->{subject};
1328             }
1329             elsif ($attr eq 'cluster_id') {
1330             return $self->hash_output->{cluster}->{id};
1331             }
1332             elsif ($attr eq 'template_id') {
1333             return $self->hash_output->{template}->{id};
1334             }
1335             elsif ($attr eq 'stop_time') {
1336             return $self->hash_output->{stop_time};
1337             }
1338             elsif ($attr eq 'creation_time') {
1339             return $self->hash_output->{creation_time};
1340             }
1341             elsif ($attr eq 'timezone') {
1342             return $self->hash_output->{timezone};
1343             }
1344             elsif ($attr eq 'usb_enabled') {
1345             return $self->hash_output->{usb}->{enabled};
1346             }
1347             elsif ($attr eq 'host_id') {
1348             return $self->hash_output->{host}->{id};
1349             }
1350             }
1351              
1352             =head1 AUTHOR
1353              
1354             "Heince Kurniawan", C<< <"heince at cpan.org"> >>
1355              
1356             =head1 BUGS
1357              
1358             Please report any bugs or feature requests to C, or through
1359             the web interface at L. I will be notified, and then you'll
1360             automatically be notified of progress on your bug as I make changes.
1361              
1362             =head1 SUPPORT
1363              
1364             You can find documentation for this module with the perldoc command.
1365              
1366             perldoc Ovirt::VM
1367              
1368             =head1 ACKNOWLEDGEMENTS
1369              
1370              
1371             =head1 LICENSE AND COPYRIGHT
1372              
1373             Copyright 2015 "Heince Kurniawan".
1374              
1375             This program is free software; you can redistribute it and/or modify it
1376             under the terms of the the Artistic License (2.0). You may obtain a
1377             copy of the full license at:
1378              
1379             L
1380              
1381             Any use, modification, and distribution of the Standard or Modified
1382             Versions is governed by this Artistic License. By using, modifying or
1383             distributing the Package, you accept this license. Do not use, modify,
1384             or distribute the Package, if you do not accept this license.
1385              
1386             If your Modified Version has been derived from a Modified Version made
1387             by someone other than you, you are nevertheless required to ensure that
1388             your Modified Version complies with the requirements of this license.
1389              
1390             This license does not grant you the right to use any trademark, service
1391             mark, tradename, or logo of the Copyright Holder.
1392              
1393             This license includes the non-exclusive, worldwide, free-of-charge
1394             patent license to make, have made, use, offer to sell, sell, import and
1395             otherwise transfer the Package with respect to any patent claims
1396             licensable by the Copyright Holder that are necessarily infringed by the
1397             Package. If you institute patent litigation (including a cross-claim or
1398             counterclaim) against any party alleging that the Package constitutes
1399             direct or contributory patent infringement, then this Artistic License
1400             to you shall terminate on the date that such litigation is filed.
1401              
1402             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
1403             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
1404             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
1405             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
1406             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
1407             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
1408             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
1409             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1410              
1411              
1412             =cut
1413              
1414             1;