#!/usr/bin/perl -w
use strict;
use Carp;
use Fcntl qw(:mode);
use POSIX qw(:sys_wait_h);

use File::Spec;
use IO::Dir;
use VMware::VmPerl;
use VMware::VmPerl::ConnectParams;
use VMware::VmPerl::VM;

sub timestamp($) {
    my ($message) = @_;
    printf STDERR "%s %s\n", scalar localtime, $message;
}


sub throw($) {
    my ($vm) = @_;
    my ($err, $errstr) = $vm->get_last_error;
    croak "VMControl error $err: $errstr";
}

sub process($$) {
    my ($vm, $proc) = @_;
    if ($vm->get_execution_state == VM_EXECUTION_STATE_ON) {
        my $name = $vm->get_config_file_name;
        timestamp "Suspending $name";
        $vm->suspend(VM_POWEROP_MODE_TRYSOFT) or throw $vm;
        &$proc;
        timestamp "Resuming $name";
        $vm->start(VM_POWEROP_MODE_TRYSOFT) or throw $vm;
    } else {
        &$proc;
    }
}

sub backup($$) {
    my ($vm_dir, $backup_prefix) = @_;
    timestamp "Backing up $vm_dir";
    system '/bin/tar', 'czSf', "$backup_prefix.tar.gz", $vm_dir;
}

die "usage: backup-vms vms-dir backup-dir\n" unless @ARGV == 2;
my ($vms_dir, $backup_dir) = @ARGV;

timestamp 'Start of backup';
tie my %vms_entries, 'IO::Dir', $vms_dir;
my @vm_dirs = grep !/^\./ && $vms_entries{$_}->mode & S_IFDIR, keys %vms_entries;
untie %vms_entries;

# The VmPerl classes' new subs are really broken: they don't use the first
# argument as the class name, and thus you aren't supposed to use constructor
# syntax with them.
my $cp = VMware::VmPerl::ConnectParams::new;
my $vm = VMware::VmPerl::VM::new;

for my $vm_dir (@vm_dirs) {
    my $full_vm_dir = File::Spec->catdir($vms_dir, $vm_dir);
    eval {
        # .vmx file assumed to be named the same as the directory
        $vm->connect($cp, File::Spec->catfile($full_vm_dir, "$vm_dir.vmx"))
            or throw $vm;
        process($vm, sub () {
            backup($full_vm_dir, File::Spec->catdir($backup_dir, $vm_dir));
        });
        $vm->disconnect;