Subversion Repositories havirt

Rev

Rev 29 | Rev 39 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 29 Rev 38
Line 26... Line 26...
26 
#
 26 
#
27 
# v1.2.0 20240826 RWR
 27 
# v1.2.0 20240826 RWR
28 
# Added some code to migrate domains if node placed in maintenance mode
 28 
# Added some code to migrate domains if node placed in maintenance mode
29 
# Added a lot of 'verbose' print lines, and modified for new flag structure
 29 
# Added a lot of 'verbose' print lines, and modified for new flag structure
30 
#
 30 
#
- 
 
 31 
# v1.2.1 20240828 RWR
- 
 
 32 
# force rescan after domain migrate (pulled out of havirt.pm:scan)
31 
 
 33 
 
32 
 
 34 
 
33 
package domain;
 35 
package domain;
34 
 
 36 
 
35 
use warnings;
 37 
use warnings;
36 
use strict;
38 
use strict;
37 
 
 39 
 
38 
# define the version number
 40 
# define the version number
39 
# see https://metacpan.org/pod/release/JPEACOCK/version-0.97/lib/version.pod
 41 
# see https://metacpan.org/pod/release/JPEACOCK/version-0.97/lib/version.pod
40 
use version;
 42 
use version;
41 
our $VERSION = version->declare("1.2.0");
 43 
our $VERSION = version->declare("1.2.1");
42 
 
 44 
 
43 
 
 45 
 
44 
use Data::Dumper;
 46 
use Data::Dumper;
45 
 
 47 
 
46 
use Exporter;
 48 
use Exporter;
Line 76... Line 78...
76 
 
 78 
 
77 
 
 79 
 
78 
# dipslay a list of domains, which node they are on and some information on them
 80 
# dipslay a list of domains, which node they are on and some information on them
79 
sub list {
 81 
sub list {
80 
   &main::readDB();
 82 
   &main::readDB();
- 
 
 83 
   #@_ = keys %{$main::statusDB->{'nodes'} } unless ( @_ );
81 
   print Dumper( $main::statusDB->{'nodePopulation'} ) if $main::config->{'flags'}->{'debug'} > 2;
 84 
   print Dumper( $main::statusDB->{'nodePopulation'} ) if $main::config->{'flags'}->{'debug'} > 2;
82 
 
 85 
 
83 
   my @header;
 86 
   my @header;
84 
   my @data;
 87 
   my @data;
85 
   my @found;
 88 
   my @found;
86
89
87 
   foreach my $node ( sort keys %{$main::statusDB->{'nodePopulation'}} ) {
 90 
   foreach my $node ( sort keys %{$main::statusDB->{'nodePopulation'}} ) {
- 
 
 91 
   #while ( my $node = shift ) {
88 
      foreach my $virt (sort keys %{$main::statusDB->{'nodePopulation'}->{$node}->{'running'}} ) {
 92 
      foreach my $virt (sort keys %{$main::statusDB->{'nodePopulation'}->{$node}->{'running'}} ) {
89 
         unless ( @header ) {
 93 
         unless ( @header ) {
90 
            # if we don't have a header yet, create it from the keys in this one. Assumes every entry has same keys
 94 
            # if we don't have a header yet, create it from the keys in this one. Assumes every entry has same keys
91 
            @header = sort keys %{ $main::statusDB->{'virt'}->{$virt} };
 95 
            @header = sort keys %{ $main::statusDB->{'virt'}->{$virt} };
92 
            unshift @header, 'Domain';
 96 
            unshift @header, 'Domain';
Line 265... Line 269...
265 
sub migrate {
 269 
sub migrate {
266 
   my ( $domain, $target ) = @_;
 270 
   my ( $domain, $target ) = @_;
267 
   if ( my $error = &main::validateResources( $target, $domain ) ) {
 271 
   if ( my $error = &main::validateResources( $target, $domain ) ) {
268 
      die $error;
 272 
      die $error;
269 
   }
 273 
   }
270 
   return &main::migrate( $domain, $target );
 274 
   my $return = &main::migrate( $domain, $target );
- 
 
 275 
   &main::forceScan();
- 
 
 276 
   return $return;
271 
}
 277 
}
272 
 
 278 
 
273 
# find an unused VNC port
 279 
# find an unused VNC port
274 
sub findVNCPort {
 280 
sub findVNCPort {
275 
   my $currentPorts = shift;
 281 
   my $currentPorts = shift;