diff --git a/lib/Ravada.pm b/lib/Ravada.pm index aa4de6fb6..1202604a4 100644 --- a/lib/Ravada.pm +++ b/lib/Ravada.pm @@ -3,7 +3,7 @@ package Ravada; use warnings; use strict; -our $VERSION = '0.2.1'; +our $VERSION = '0.2.2'; use Carp qw(carp croak); use Data::Dumper; diff --git a/lib/Ravada/Domain.pm b/lib/Ravada/Domain.pm index 58256b6d9..e8a2e9e4b 100644 --- a/lib/Ravada/Domain.pm +++ b/lib/Ravada/Domain.pm @@ -478,9 +478,22 @@ sub _insert_db { } +=head2 pre_remove + +Code to run before removing the domain. It can be implemented in each domain. +It is not expected to run by itself, the remove function calls it before proceeding. + + $domain->pre_remove(); # This isn't likely to be necessary + $domain->remove(); # Automatically calls the domain pre_remove method + +=cut + +sub pre_remove { } + sub _pre_remove_domain { my $self = shift; eval { $self->id }; + $self->pre_remove(); $self->_allow_remove(@_); } diff --git a/lib/Ravada/Domain/KVM.pm b/lib/Ravada/Domain/KVM.pm index d7f49f14e..035afed7a 100644 --- a/lib/Ravada/Domain/KVM.pm +++ b/lib/Ravada/Domain/KVM.pm @@ -1340,4 +1340,20 @@ sub _set_driver_sound { } +=head2 pre_remove + +Code to run before removing the domain. It can be implemented in each domain. +It is not expected to run by itself, the remove function calls it before proceeding. +In KVM it removes saved images. + + $domain->pre_remove(); # This isn't likely to be necessary + $domain->remove(); # Automatically calls the domain pre_remove method + +=cut + +sub pre_remove { + my $self = shift; + $self->domain->managed_save_remove if $self->domain->has_managed_save_image; +} + 1; diff --git a/t/vm/h10_hybernate.t b/t/vm/h10_hybernate.t index e61ffe6cd..043923bcd 100644 --- a/t/vm/h10_hybernate.t +++ b/t/vm/h10_hybernate.t @@ -22,6 +22,69 @@ my %ARG_CREATE_DOM = ( my @VMS = reverse keys %ARG_CREATE_DOM; my $USER = create_user("foo","bar"); +sub test_hybernate { + my $vm_name = shift; + + my $domain = create_domain($vm_name, $USER) or next; + + next if !$domain->can_hybernate(); + + $domain->start($USER) if !$domain->is_active; + + eval { $domain->hybernate($USER) }; + ok(!$@,"Expecting no error hybernating, got : ".($@ or '')); + + is($domain->is_active,0); + + $domain->start($USER); + is($domain->is_active,1); + + return $domain; + +} + +sub test_hybernate_clone { + my ($vm_name, $domain) = @_; + + my $clone = $domain->clone(name => new_domain_name(), user => $USER); + + eval {$clone->start($USER) if !$clone->is_active }; + is($clone->is_active,1) or return; + + eval { $clone->hybernate($USER) }; + ok(!$@,"Expecting no error hybernating, got : ".($@ or '')); + is($clone->is_active,0,"$vm_name hybernate"); + + eval {$clone->start($USER) }; + ok(!$@,"Expecting no error restarting, got : ".($@ or '')); + is($clone->is_active,1); + +} + +sub test_hybernate_clone_swap { + my ($vm_name, $domain) = @_; + + $domain->add_volume_swap( size => 1024*512); + test_hybernate_clone($vm_name,$domain); +} + +sub test_remove_hybernated { + my ($vm_name, $domain) = @_; + + my $clone = $domain->clone(name => new_domain_name(), user => $USER); + $clone->start($USER) if !$clone->is_active; + + eval { $clone->hybernate($USER) }; + ok(!$@,"Expecting no error hybernating, got : ".($@ or '')); + + is($clone->is_active,0); + + eval{ $clone->remove($USER) }; + ok(!$@,"Expecting no error removing , got : ".($@ or '')); + + +} + ################################################################ clean(); @@ -40,20 +103,11 @@ for my $vm_name ( @{rvd_front->list_vm_types}) { skip($msg,10) if !$vm; - my $domain = create_domain($vm_name, $USER) or next; - - next if !$domain->can_hybernate(); - - $domain->start($USER) if !$domain->is_active; - - eval { $domain->hybernate($USER) }; - ok(!$@,"Expecting no error hybernating, got : ".($@ or '')); - - is($domain->is_active,0); - - $domain->start($USER); - is($domain->is_active,1); + my $domain = test_hybernate($vm_name); + test_hybernate_clone($vm_name, $domain); + test_hybernate_clone_swap($vm_name, $domain); + test_remove_hybernated($vm_name,$domain); } }