#! /usr/bin/perl -w

use YAML::XS qw(DumpFile LoadFile); # libyaml-libyaml-perl
use Getopt::Std;

$main::VERSION = '0.1';

my $dbFile = 'dom0_db.yaml';
my $lockFile = 'dom0_db.lock';
my $command = 'virsh'; $command = 'xl' unless `which $command`;

#
# find where the script is actually located as cfg should be there
#
sub getScriptLocation {
   use strict;
   use File::Spec::Functions qw(rel2abs);
   use File::Basename;
   return dirname(rel2abs($0));
}

sub main::HELP_MESSAGE {
   print "\nScript to read output of xl list, parse it and store results in database\n\n";
   print "-s          Show database\n";
   print "-c filename Use alternative database\n";
   print "-n          Don't update the database\n";
   print "-v          Be Verbose (show some stats)\n";
   print "-r          Report - only display if something changed\n";
}

sub main::VERSION {
   &HELP_MESSAGE();
}

sub readDB {
   my $lock = shift;
   my $db;
   sleep(5) if -e $lockFile;
   die "Could not get lock on $dbFile: Aborting\n" if -e $lockFile;
   `touch $lockFile` unless $lock;
   $db = LoadFile( $dbFile ) if ( -e $dbFile );
   return $db;
}

sub saveDB {
   my ($db,$dirtyCount, $verbose)  = @_;
   if ( $dirtyCount ) {
      print "Updating database since $dirtyCount changes found\n" if $verbose;
      DumpFile( $dbFile, $db );
   }
   `rm $lockFile` if -e $lockFile;
}

sub showDOMUs {
   my $db = shift;
   foreach my $domu ( sort keys %$db ) {
      print "$domu\t$$db{$domu}->{'server'}\n";
   }
}
   
sub trim {
   my $string = shift;
   $string =~ s/^\s+|\s+$//;
   return $string;
}

sub getHeader {
   my ($line) = @_;
   my @return = split( '\s+', trim( $line ) );
   return @return;
}

sub parseALine {
   my ($line, @headers ) = @_;
   my %return;
   # next line see http://www.perlmonks.org/?node_id=4402
   @return{@headers} = split( '\s+', trim( $line ) );
   return %return;
}

sub updateDB {
   my ( $db, $self, $verbose ) = @_;
   my $new = 0;
   my $moved = 0;
   my $removed = 0;
   use Data::Dumper;

   my @domains = `$command list`;
   chomp @domains;
   my @fieldnames = &getHeader( $domains[0] );
   
   my %found;
   
   for ($i = 1; $i < @domains; $i++ ) {
      next if $domains[$i] =~ m/^[=-]*$/;
      my %thisLine = &parseALine( $domains[$i], @fieldnames );
      next if $thisLine{'Name'} eq 'Domain-0';
      $found{ $thisLine{'Name'} } = 1;
      unless ( exists $$db{$thisLine{'Name'}} ) {
         $$db{$thisLine{'Name'}} = \%thisLine;
         print "adding $thisLine{'Name'}\n" if $verbose;
         $new++;
      }
      unless ( exists $$db{$thisLine{'Name'}}->{'server'} && $$db{$thisLine{'Name'}}->{'server'} eq $self ) {
         $$db{$thisLine{'Name'}}->{'server'} = $self;
         print "$thisLine{'Name'} has moved to me ($self)\n" if $verbose;
         $moved++;
      }
   }
   # clean up any entries which were here, but are not any longer
   foreach $entry ( keys %$db ) {
      if ( $db->{$entry}->{'server'} eq $self && ! defined ( $found{$entry} ) ) {
         # it used to be here, but now it is gone
         $db->{$entry}->{'server'} = '';
         $removed++;
      } # if
   } # foreach
   print "$new new virtuals found, $removed removed  and $moved virtuals moved\n" if ( $verbose );
   return ($new+$moved+$removed,$db);
}             

my $path = &getScriptLocation() . '/';
$dbFile = $path . $dbFile;
$lockFile = $path . $lockFile;


$Getopt::Std::STANDARD_HELP_VERSION = 1;
my %options = ();
getopts( 'vosrc:n', \%options );

if ( $options{'o'} ) {
   print "Dumping cli parameters\n";
   foreach my $option ( keys %options ) {
      print "$option\t[$options{$option}]\n";
   }
}


my $db = &readDB( $options{'n'} );

unless ( $options{ 'n' } ) {
   my $dirtyCount;
   print STDERR "Updating the database\n" if $options{'v'};
   my $self = `hostname`;
   chomp $self;
   ($dirtyCount,$db) = &updateDB( $db,$self, $options{'v'} );
   print "Virtuals changed on $self\n" if ($options{'r'} && $dirtyCount);
   &saveDB( $db, $dirtyCount, $options{'v'} );
}

&showDOMUs( $db ) if $options{'s'};

1;

