[#67] first step to remove id_base after prepare base

lib/Ravada/Domain.pm

@@ -92,18 +92,8 @@ before 'remove' => \&_allow_remove;
  after 'remove' => \&_after_remove_domain;
 
 before 'prepare_base' => \&_allow_prepare_base;
- after 'prepare_base' => sub {
-    my $self = shift;
-
-    my ($user) = @_;
-
-    $self->is_base(1);
-    if ($self->{_was_active} ) {
-        $self->resume($user);
-    }
-    delete $self->{_was_active};
-};
-
+ after 'prepare_base' => \&_post_prepare_base;
+ 
 before 'start' => \&_start_preconditions;
  after 'start' => \&_post_start;
 
@@ -189,6 +179,21 @@ sub _allow_prepare_base {
     }
 };
 
+sub _post_prepare_base {
+    my $self = shift;
+
+    my ($user) = @_;
+
+    $self->is_base(1);
+    if ($self->{_was_active} ) {
+        $self->resume($user);
+    }
+    delete $self->{_was_active};
+
+    $self->_remove_id_base();
+};
+
+
 sub _check_has_clones {
     my $self = shift;
     return if !$self->is_known();
@@ -440,6 +445,18 @@ sub _remove_files_base {
 }
 
 
+sub _remove_id_base {
+
+    my $self = shift;
+
+    my $sth = $$CONNECTOR->dbh->prepare(
+        "UPDATE domains set id_base=NULL "
+        ." WHERE id=?"
+    );
+    $sth->execute($self->id);
+    $sth->finish;
+}
+
 =head2 is_base
 Returns true or  false if the domain is a prepared base
 =cut

t/vm/95_spinoff.t

 use warnings;
 use strict;
 
+use Carp qw(confess);
 use Data::Dumper;
 use Test::More;
 use Test::SQL::Data;
@@ -62,10 +63,20 @@ sub test_create_domain {
     return $domain;
 }
 
+sub test_clone {
+    my ($vm_name, $domain) = @_;
+
+    my $clone = $domain->clone(name => new_domain_name(), user => $USER);
+    ok($clone);
+
+    return $clone;
+}
+
 sub test_files_base {
-    my $domain = shift;
-    my $n_expected = shift;
+    my ($domain, $n_expected) = @_;
 
+    confess("Expecting a domain , got ".Dumper(\@_))
+        if !ref $domain;
     my @files = $domain->list_files_base();
 
     ok(scalar @files == $n_expected,"Expecting $n_expected files base , got "
@@ -91,72 +102,7 @@ sub test_prepare_base {
 
     test_files_base($domain,1);
 
-    my @disk = $domain->disk_device();
-    $domain->shutdown(user => $USER);
-
-    touch_mtime(@disk);
-
-    eval { $domain->prepare_base( $USER) };
-    ok(!$@,"Trying to prepare base again failed, it should have worked. ");
-    ok($domain->is_base);
-
-    my $name_clone = new_domain_name();
-
-    my $domain_clone;
-    eval { $domain_clone = $RVD_BACK->create_domain(
-        name => $name_clone
-        ,id_owner => $USER->id
-        ,id_base => $domain->id
-        ,vm => $vm_name
-        );
-    };
-    ok(!$@,"Clone domain, expecting error='' , got='".($@ or '')."'") or exit;
-    ok($domain_clone,"Trying to clone from ".$domain->name." to $name_clone");
-    test_devices_clone($vm_name, $domain_clone);
-    test_display($vm_name, $domain_clone);
-
-    ok($domain_clone->id_base && $domain_clone->id_base == $domain->id
-        ,"[$vm_name] Expecting id_base=".$domain->id." got ".($domain_clone->id_base or '<UNDEF>')) or exit;
-
-    my $domain_clone2 = $RVD_FRONT->search_clone(
-         id_base => $domain->id,
-        id_owner => $USER->id
-    );
-    ok($domain_clone2,"Searching for clone id_base=".$domain->id." user=".$USER->id
-        ." expecting domain , got nothing "
-        ." ".Dumper($domain)) or exit;
-
-    if ($domain_clone2) {
-        ok( $domain_clone2->name eq $domain_clone->name
-        ,"Expecting clone name ".$domain_clone->name." , got:".$domain_clone2->name
-        );
-
-        ok($domain_clone2->id eq $domain_clone->id
-        ,"Expecting clone id ".$domain_clone->id." , got:".$domain_clone2->id
-        );
-    }
-
-
-    touch_mtime(@disk);
-    eval { $domain->prepare_base($USER) };
-    ok($@ && $@ =~ /has \d+ clones/i
-        ,"[$vm_name] Don't prepare if there are clones ".($@ or '<UNDEF>'));
-    ok($domain->is_base);
-
-    $domain_clone->remove($USER);
-
-    touch_mtime(@disk);
-    eval { $domain->prepare_base($USER) };
-
-    ok(!$@,"[$vm_name] Error preparing base after clone removed :'".($@ or '')."'");
-    ok($domain->is_base,"[$vm_name] Expecting domain is_base=1 , got :".$domain->is_base);
-
-    $domain->is_base(0);
-    ok(!$domain->is_base,"[$vm_name] Expecting domain is_base=0 , got :".$domain->is_base);
-
-    $domain->is_base(1);
-    ok($domain->is_base,"[$vm_name] Expecting domain is_base=1 , got :".$domain->is_base);
-
+    is($domain->id_base,undef);
 }
 
 sub test_remove_base {
@@ -176,6 +122,23 @@ sub test_remove_base {
     for my $file (@files) {
         ok(!-e $file,"Expecting file base '$file' removed" );
     }
+
+    my $vm = rvd_back->search_vm($vm_name);
+    my $domain_clone2 = $vm->search_domain($domain_clone->name);
+    ok($domain_clone2,"Expecting clone still there");
+}
+
+sub test_remove_domain {
+    my $vm_name = shift;
+    my $domain = shift;
+    my $domain_clone = shift;
+
+    $domain->remove($USER);
+
+    my $vm = rvd_back->search_vm($vm_name);
+    my $domain2 = $vm->search_domain($domain->name);
+    ok(!$domain2,"Expecting no domain after remove");
+
 }
 
 #######################################################################33