force testing of KVM backend

lib/Ravada.pm

@@ -3,6 +3,7 @@ package Ravada;
 use warnings;
 use strict;
 
+use Carp qw(carp);
 use Data::Dumper;
 use DBIx::Connector;
 use JSON::XS;
@@ -165,9 +166,13 @@ sub create_domain {
     my $backend = $args{backend};
     delete $args{backend};
 
+
     my $vm = $self->vm->[0];
     $vm = $self->search_vm($backend)   if $backend;
 
+    carp "WARNING: no backend defined, we will use ".$vm->name
+        if !$backend;
+
     return $vm->create_domain(@_);
 }
 
@@ -206,7 +211,7 @@ sub search_domain {
         my $id;
         eval { $id = $domain->id };
         # TODO import the domain in the database with an _insert_db or something
-        warn $@ if $@;
+        warn $@ if $@   && $DEBUG;
         return $domain if $id || $import;
     }
     return;

lib/Ravada/Domain/KVM.pm

@@ -127,7 +127,7 @@ sub _vol_remove {
     return 1;
 }
 
-=head2 removekvm_22_domain_kvm_base.ro.qcow2
+=head2 remove
 
 Removes this domain. It removes also the disk drives and base images.
 

lib/Ravada/VM.pm

@@ -63,4 +63,12 @@ sub domain_remove {
     $self->_domain_remove_bd();
 }
 
+sub name {
+    my $self = shift;
+
+    my ($ref) = ref($self) =~ /.*::(.*)/;
+
+    return ($ref or ref($self));
+}
+
 1;

lib/Ravada/VM/LXC.pm

@@ -20,6 +20,7 @@ our $CMD_LXC_LS;
 our $CONNECTOR = \$Ravada::CONNECTOR;
 
 sub BUILD {
+    die "LXC disabled in this release";
     my $self = shift;
 
     $self->connect()                if !defined $CMD_LXC_LS;

t/kvm/12_vm_kvm.t

@@ -6,7 +6,8 @@ use Test::SQL::Data;
 
 my $test = Test::SQL::Data->new();
 
-my $CLASS= 'Ravada::VM::KVM';
+my $BACKEND = 'KVM';
+my $CLASS= "Ravada::VM::$BACKEND";
 
 use_ok('Ravada');
 use_ok($CLASS);
@@ -14,7 +15,7 @@ use_ok($CLASS);
 ##########################################################
 
 sub test_vm_connect {
-    my $vm = Ravada::VM::KVM->new();
+    my $vm = Ravada::VM::KVM->new(backend => $BACKEND );
     ok($vm);
     ok($vm->type eq 'qemu');
     ok($vm->host eq 'localhost');
@@ -23,8 +24,8 @@ sub test_vm_connect {
 
 sub test_search_vm {
     my $ravada = Ravada->new();
-    my $vm = $ravada->search_vm('kvm');
-    ok($vm,"I can't find a KVM virtual manager");
+    my $vm = $ravada->search_vm($BACKEND);
+    ok($vm,"I can't find a $BACKEND virtual manager");
     ok(ref $vm eq $CLASS,"Virtual Manager is of class ".(ref($vm) or '<NULL>')
         ." it should be $CLASS");
 }
@@ -36,7 +37,7 @@ eval { $RAVADA = Ravada->new() };
 
 my $vm;
 
-eval { $vm = $RAVADA->search_vm('kvm') } if $RAVADA;
+eval { $vm = $RAVADA->search_vm($BACKEND) } if $RAVADA;
 
 SKIP: {
     my $msg = "SKIPPED test: No VM backend found";

t/kvm/20_domain_kvm.t

@@ -6,8 +6,10 @@ use IPC::Run3;
 use Test::More;
 use Test::SQL::Data;
 
+my $BACKEND = 'KVM';
+
 use_ok('Ravada');
-use_ok('Ravada::Domain::KVM');
+use_ok("Ravada::Domain::$BACKEND");
 
 my $test = Test::SQL::Data->new( config => 't/etc/ravada.conf');
 my $RAVADA;
@@ -72,7 +74,9 @@ sub test_new_domain {
     test_remove_domain($name);
 
     diag("Creating domain $name");
-    my $domain = $RAVADA->create_domain(name => $name, id_iso => 1, active => $active);
+    my $domain = $RAVADA->create_domain(name => $name, id_iso => 1, active => $active
+        , backend => $BACKEND
+    );
 
     ok($domain,"Domain not created");
     my $exp_ref= 'Ravada::Domain::KVM';

t/kvm/22_domain_kvm_base.t

@@ -8,8 +8,11 @@ use Test::More;
 use Test::SQL::Data;
 use XML::LibXML;
 
+my $BACKEND = 'KVM';
+
 use_ok('Ravada');
-use_ok('Ravada::Domain::KVM');
+use_ok("Ravada::Domain::$BACKEND");
+
 
 my $test = Test::SQL::Data->new( config => 't/etc/ravada.conf');
 my $RAVADA;
@@ -60,7 +63,11 @@ sub test_new_domain_from_iso {
 
     diag("Creating domain $name from iso");
     my $domain;
-    eval { $domain = $RAVADA->create_domain(name => $name, id_iso => 1) };
+    eval { $domain = $RAVADA->create_domain(name => $name
+                                        , id_iso => 1
+                                        ,backend => $BACKEND
+            ) 
+    };
     ok(!$@,"Domain $name not created: $@");
 
     ok($domain,"Domain not created") or return;
@@ -113,7 +120,11 @@ sub test_new_domain_from_base {
     test_remove_domain($name);
 
     diag("Creating domain $name from ".$base->name);
-    my $domain = $RAVADA->create_domain(name => $name, id_base => $base->id);
+    my $domain = $RAVADA->create_domain(
+                name => $name
+            ,id_base => $base->id
+            ,backend => $BACKEND
+    );
     ok($domain,"Domain not created");
     my $exp_ref= 'Ravada::Domain::KVM';
     ok(ref $domain eq $exp_ref, "Expecting $exp_ref , got ".ref($domain))

t/kvm/30_request.t

@@ -8,6 +8,8 @@ use Test::SQL::Data;
 use_ok('Ravada');
 use_ok('Ravada::Request');
 
+my $BACKEND = 'KVM';
+
 my $test = Test::SQL::Data->new(config => 't/etc/ravada.conf');
 
 my $RAVADA;
@@ -62,8 +64,9 @@ sub test_req_create_domain_iso {
 
     diag("requesting create domain $name");
     my $req = Ravada::Request->create_domain( 
-        name => $name
-        ,id_iso => 1
+            name => $name
+         ,id_iso => 1
+        ,backend => $BACKEND
     );
     ok($req);
     ok($req->status);

t/pod_coverage.t

@@ -11,7 +11,7 @@ SKIP: {
     diag($@) if $@;
     skip(2,$@)  if $@;
     for my $type ( qw(VM Domain) ){
-        for my $backend (qw(KVM LXC)) {
+        for my $backend (qw(KVM)) {
             Test::Pod::Coverage::pod_coverage_ok( "Ravada::$type::$backend"
                 , "Ravada::$type::$backend is covered" );
         }