Commit 78949d7f authored by Francesc Guasch's avatar Francesc Guasch
Browse files

[#43] clone implemented and tested

parent 483752c8
......@@ -553,4 +553,42 @@ sub _remove_base_db {
}
=head2 clone
Clones a domain
=head3 arguments
=over
=item user => $user : The user that owns the clone
=item name => $name : Name of the new clone
=back
=cut
sub clone {
my $self = shift;
my %args = @_;
my $name = $args{name} or confess "ERROR: Missing domain cloned name";
confess "ERROR: Missing request user" if !$args{user};
my $uid = $args{user}->id;
$self->prepare_base($args{user}) if !$self->is_base();
my $id_base = $self->id;
return $self->_vm->create_domain(
name => $name
,id_base => $id_base
,id_owner => $uid
,vm => $self->vm
);
}
1;
use warnings;
use strict;
use Data::Dumper;
use Test::More;
use Test::SQL::Data;
use lib 't/lib';
use Test::Ravada;
my $test = Test::SQL::Data->new(config => 't/etc/sql.conf');
use_ok('Ravada');
my $FILE_CONFIG = 't/etc/ravada.conf';
my $RVD_BACK = rvd_back($test->connector, $FILE_CONFIG);
my $RVD_FRONT= rvd_front($test->connector, $FILE_CONFIG);
my %ARG_CREATE_DOM = (
KVM => [ id_iso => 1 ]
,Void => [ ]
);
my @ARG_RVD = ( config => $FILE_CONFIG, connector => $test->connector);
my @VMS = reverse keys %ARG_CREATE_DOM;
my $USER = create_user("foo","bar");
###############################################################################
sub test_create_domain {
my $vm_name = shift;
my $ravada = Ravada->new(@ARG_RVD);
my $vm = $ravada->search_vm($vm_name);
ok($vm,"I can't find VM $vm_name") or return;
my $name = new_domain_name();
if (!$ARG_CREATE_DOM{$vm_name}) {
diag("VM $vm_name should be defined at \%ARG_CREATE_DOM");
return;
}
my @arg_create = @{$ARG_CREATE_DOM{$vm_name}};
my $domain;
eval { $domain = $vm->create_domain(name => $name
, id_owner => $USER->id
, @{$ARG_CREATE_DOM{$vm_name}})
};
ok($domain,"No domain $name created with ".ref($vm)." ".($@ or '')) or exit;
ok($domain->name
&& $domain->name eq $name,"Expecting domain name '$name' , got "
.($domain->name or '<UNDEF>')
." for VM $vm_name"
);
return $domain;
}
###############################################################################
remove_old_domains();
remove_old_disks();
for my $vm_name (reverse sort @VMS) {
diag("Testing $vm_name VM") if $vm_name !~ /Void/i;
my $CLASS= "Ravada::VM::$vm_name";
use_ok($CLASS);
my $vm;
eval { $vm = $RVD_BACK->search_vm($vm_name) } if $RVD_BACK;
SKIP: {
my $msg = "SKIPPED test: No $vm_name VM found ";
diag($msg) if !$vm;
skip $msg,10 if !$vm;
my $domain = test_create_domain($vm_name);
my $name_clone = new_domain_name();
my $clone = $domain->clone(name => $name_clone, user => $USER);
ok($clone,"Expecting new cloned domain");
my $clone2 = $RVD_FRONT->search_domain($name_clone);
ok($clone,"Expecting new cloned domain ".$name_clone);
}
}
remove_old_domains();
remove_old_disks();
done_testing();
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment