#! /usr/bin/env perl

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

$main::VERSION = '0.1';

my $dbFile = 'virtinfo_db.yaml';
my $lockFile = 'virtinfo.lock';


use Data::Dumper;


#
# 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 reads running virtuals and store results in database\n\n";
   print "-s          Show database and exit\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, $verbose)  = @_;
   print "Updating database\n" if $verbose;
   DumpFile( $dbFile, $db );
}

# many of the outputs produce key:value pairs
# we will parse this into a hash
sub parseDelimited {
   my $delimiter = shift;
   my %return;
   while ( my $line = shift ) {
      chomp $line;
      next unless $line;
      my ( $key, $value ) = split( /$delimiter/, $line );
      $return{lc &trim($key) } = &trim($value);
   }
   return \%return;
}
   

sub getNode {
   my @info = `virsh nodeinfo`;
   my $hypervisor = &parseDelimited( ':', @info );
   return $hypervisor;
}


sub getRunningVirtuals {
   my @domains = `virsh list`;
   chomp @domains;
   my %domains;
   foreach my $domain ( @domains ) {
      # skip the headers
      next if $domain =~ m/^(Id)|(--)/;
      if ( $domain =~ m/^\s*(\d+)\s+([^\s]+)\s/ ) {
         $domains{$2}{'id'} = $1;
      }
   }
   return \%domains;
}

sub updateDB {
   my ( $node, $self, $verbose ) = @_; 
   # get a list of all running virtuals
   my $virts = &getRunningVirtuals();
   my @a = sort keys %$virts;
   my @b = sort keys  %{ $node->{$self}->{'virtuals'} };
   return 0 # return if they are the same, no action needed
      if &compareArray( \@a, \@b );
   # something has changed, so load all information again
   print "Something has changed, so loading everything again\n" if $verbose;
   $node->{$self}->{'hypervisor'} = &getNode();
   $node->{$self}->{'virtuals'} = $virts;;
   foreach my $domain ( keys %{$node->{$self}->{'virtuals'}} ) {
      next unless $domain;
      my @info = `virsh dominfo $domain`;
      my $vnc = `virsh vncdisplay $domain`;
      chomp $vnc;
      $vnc =~ m/^.*:(\d+)$/;
      push @info, "vncport: $1";
      $node->{$self}->{'virtuals'}->{$domain} = &parseDelimited( ':', @info );
   }
   return ( 1, $node );;
}


# remove leading and trailing whitespace from string
sub trim {
   my $string = shift;
   $string =~ s/^\s+|\s+$//;
   return $string;
}

sub showReport {
   my $conf = shift;
   foreach my $node ( keys %$conf ) {
      print "$node\n";
      foreach my $virt ( keys %{ $conf->{$node}->{'virtuals'} } ) {
         print "\t$virt\n";
      }
   }
}


sub compareArray {
   my ($arr1, $arr2 ) = @_;
   # if they don't have the same number of elements, not equal
   return 0 if @$arr1 != @$arr2;
   for ( my $i = 0; $i < scalar( @$arr1 ); $i++ ) {
      return 0 unless $$arr1[$i] eq $$arr2[$i];
   }
   return 1;
}
   

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'} );

my $self = `hostname -f`;
chomp $self;

if ( $options{'s'} ) {
   &showReport( $db );
} elsif ( ! $options{ 'n' } ) {
   print STDERR "Updating the database\n" if $options{'v'};
   my $dirty = 0;
   ( $dirty, $db ) = &updateDB( $db,$self, $options{'v'} );
   if ( $dirty ) {
      print "Virtuals changed on $self\n" if ($options{'r'});
      &saveDB( $db, $options{'v'} );
   }
}

`rm $lockFile` if -e $lockFile;


1;