#
# Copyright 1998 VMware, Inc.  All rights reserved. -- VMware Confidential
#

package VMware::Control::VMScript;

use strict;

#Note: "our" is not supported in 5.005_03
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
BEGIN{$VERSION = '1.01';}

use VMware::Control     $VERSION; # For error codes
use VMware::Control::VM $VERSION;
use Getopt::Std;

use POSIX qw(strftime);
require Exporter;

#Do a backtrace on errors
use Carp qw( croak confess );


@ISA = qw(Exporter);

@EXPORT = qw(
             VMScriptInitialize
             VMScriptDestroy

             setVerbose
             setInteractive
             setRecord
             setKeyboardDefinition
             setScreenshotDirectories
	     setPeriodicScreenshotTime
             setCallback
             setSlowdown
             setLogFilename

             configFilename
             hostOS
             buildNumber
             productName
             productVersion

             isOn
             isRecordMode

             PowerOn
             PowerOff
             SoftShutdown
             Reset
             SoftReset
             Suspend
             Resume
             KeyDown
             KeyUp
             KeyStroke
             KeyType
             mSleep
             Sleep
             SaveScreenshot
	     SetBugList
             WaitForScreenshot
             ToolsInstallBegin
             ToolsInstallEnd
             DeviceConnect
             DeviceDisconnect
             Connect
             Disconnect
             Log
             Get
             GetConfigValue
             SetConfigValues
             ); 

#
# Internal state, established at init/connect time
#
my $vm;
my $vms;
my ($productName, $hostOS, $productVersion, $buildNumber);

#
# Options
#
my $record;
my $devel;
my $slowdown = 1; #slowdown timeouts by this factor
my $verbose = 0;
my $interactive = 0;
my $keyboard_definition_file;
my $screenshots_load_dir;
my $screenshots_save_dir;
my $screenshots_save_base;
my $periodicScreenshotTime = 0;
my $log_filename;
my $initted;
my $gcBug;

#
# More internal state, can be modified by the script
#
my $script_success_flag = 1;

my $log_fh;

my %callbacks = ( script_failure => \&default_script_failure_callback,
                  instruction_success => \&default_instruction_success_callback,
                  script_success => \&default_script_success_callback
                  );
		 
# List to hold the list of bugs that are known to have been hit for the next 
# function to be executed. This is set by SetBugList, and is cleared by the
# actual function on completion.
my @bug_list;
		  
END { script_success(); }

###
# Internal functions
###

sub string_time {
    my $localtime = localtime;
    return $localtime;
}

sub line_number {

    my ($i, $package, $filename, $line, $subroutine, $hasargs,
        $wantarray, $evaltext, $is_require, $hints, $bitmask);

    $i = 0;
    do {
        ($package, $filename, $line, $subroutine, $hasargs,
         $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller($i);
        if ($package eq "main") {
            return $line;
        }
        $i++;
    } while ($package);
    return undef;
}

my @log = ();

# log just to the internal array and the logfile
sub _log {
    my @lines = ("[". string_time() . "] (line " .
        line_number() . ") ", @_);
    push @log, @lines;
    if (defined($log_fh)) {
        print $log_fh @lines;
    }
}

# log like _log, plus to STDERR if verbose
sub Log {
    print STDERR @_ if($verbose);
    _log(@_);
}

# alwyas log to STDERR and the logfile
sub print_error {
    print STDERR @_; # Always, even if !$verbose
    _log (@_);
}

sub log_and_die {
    _log (@_,"\n");
    croak @_;
}


###
# Options that can be toggled
###
sub setVerbose {
    my $old_verbose = $verbose;
    $verbose = shift;
    if (!$old_verbose && $verbose) {
        Log "Verbose mode.\n";
    }
}

sub setInteractive {
    my $old_interactive = $interactive;
    $interactive = shift;
    if (!$old_interactive && $interactive) {
        Log "Interactive mode.\n";
    } elsif ($old_interactive && !$interactive) {
        Log "Non-Interactive mode.\n";
    }
}

sub setRecord {
    my $old_record = $record;
    $record = shift;
    if (!$old_record && $record) {
        Log "Record mode:  WaitForScreenshot will overwrite existing screenshots\n";
    } elsif ($old_record && !$record) {
        Log "Playback mode: WaitForScreenshot matches against existing screenshots\n";
    }
}

sub setDevel {
    my $old_devel = $devel;
    if (!$old_devel && $devel) {
        Log "Devel-mode: backtrace on failures.\n";
    }
    if ($devel) {
        #Do a backtrace on errors
        $SIG{ __DIE__ } = \&confess;
    }
}

sub setSlowdown {
    my $old_slowdown = $slowdown;
    $slowdown = shift;
    if ($slowdown != $old_slowdown) {
        Log "Slowdown factor $slowdown.\n";
    }
}

sub setKeyboardDefinition {
    $keyboard_definition_file = shift;
}

sub setScreenshotDirectories {
    ($screenshots_load_dir, $screenshots_save_dir, $screenshots_save_base) =
        (shift, shift, shift);
}

sub setPeriodicScreenshotTime {
    $periodicScreenshotTime = shift;
}

# (Only works in a behavior file)
sub setLogFilename {
    $log_filename = shift;
}

###
# Read-only functions
###
sub configFilename {
    my $cfg = $vm->get("Config.filename");
    return $cfg;
}

sub productName {
    return $productName;
}

sub productVersion {
    return $productVersion;
}

sub hostOS {
    return $hostOS;
}

sub buildNumber {
    return $buildNumber;
}

###
# Initialization
###
sub process_options {
    my $opts_ref = shift;
    my %opts = %{$opts_ref};

    if ($opts{'v'}) {
        setVerbose(1);
    }

    if ($opts{'i'}) {
        setInteractive(1);
    }

    if ($opts{'q'}) {
        setVerbose(0);
        setInteractive(0);
    }

    if ($opts{'r'}) {
        setRecord(1);
    }

    if ($opts{'l'}) {
        setScreenshotDirectories($opts{'l'});
    }

    if ($opts{'I'}) {
        setPeriodicScreenshotTime($opts{'I'});
    }
}


sub VMScriptInitialize {
    my $ret;
    my %opts;

    if ( $initted ) {
        return ( $vm, $vms );
    }

    Log "Begin VMScript log file\n";

    ##
    ## Process options
    ## -b behavior_file
    ## -l directory (load screenshots from this directory)
    ## -h host -P port -u username -p password
    ## -v (verbose)
    ## -i (interactive)
    ## -r (record)
    ## -q (quiet)
    ## -I (periodic screenshot interval)
    ##
    getopt('blhPupI', \%opts);

    my ($host, $port, $user, $pass) = ($opts{'h'}, $opts{'P'},
                                       $opts{'u'}, $opts{'p'});

    # Process the command-line options so they are correct during
    #  execution of the behavior file
    process_options(\%opts);

    my $behavior_file = $opts{'b'};
    if (!$behavior_file) {
       if (! $record) {
          # load default behavior file
          my $default = "behaviors/default.pl";
          if (-f $default) {
             $behavior_file = $default;
          }
       }
    }
    if ($behavior_file) {
       load_behavior_file($behavior_file) ||
           log_and_die "Failed to load behavior file " . $opts{'b'};
    }

    # Process options again to override settings in the behavior file
    process_options(\%opts);

    ##
    ## Connect to VM
    ##
    my $cfg = $ARGV[0];

    if (!defined($cfg)) {
        log_and_die "Please specify a VM config file to connect to!";
    }

    $vms = &VMware::Control::Server::new($host, $port, $user, $pass);
    $vm = &VMware::Control::VM::new($vms, $cfg);

    if (! $vm || ! $vm->connect(1)) {
        my ($err, $errstr) = $vm->get_last_error();
        print_error "$0: Could not connect\n";
        print_error "  (VMControl error $err: $errstr)\n";
        exit(1);
    }

    ##
    ## Open log file
    ##
    if (!defined($log_filename)) {
        my ($config_dir, undef) = config_dir_base();
        # XXX Should we pick a better name than "vmscript.log"?
        $log_filename = $config_dir . "/vmscript.log";
    }

    if (-f $log_filename) {
        print_error "Overwriting $log_filename\n";
    }
    $log_fh = new FileHandle;
    if (open($log_fh, ">$log_filename")) {
        autoflush $log_fh 1;
        print $log_fh @log; # Log the early log lines
    } else {
        $log_fh = undef;
        log_and_die "Could not open log file $log_filename";
    }

    my $connect_msg = "Connected to ";
    $connect_msg .= "host $host, " if (defined($host));
    $connect_msg .= "port $port, " if (defined($port));
    $connect_msg .= "user $user, " if (defined($user));
    Log $connect_msg . "$cfg\n";

    my $vmx_cfg = configFilename();
    if ($vmx_cfg ne $cfg) {
        Log "Server reports config file is actually named $vmx_cfg.\n";
    }

    ##
    ## Log server version
    ##
    my $version = $vm->get("Status.version");
    log_and_die "Could not get server version." unless defined($version);
    Log "Server is: $version\n";

    if ($version =~ m/^(VMware .+) \((.+)\) Version (.+) Build (.*)$/) {
        ($productName, $hostOS, $productVersion, $buildNumber) =
            ($1, $2, $3, $4);
    } else {
        log_and_die "Could not parse server version information.";
    }

    ##
    ## Load keyboard file
    ##
    if (!defined($keyboard_definition_file)) {
        my @defaults;
        if ( $^O eq "MSWin32" ) {
            @defaults = ( 'C:\Program Files\VMware\Programs\xkeymap\us101',
                          'M:\mks\data\xkeymap\us101',
                          'C:\cvs\bora\mks\data\xkeymap\us101',
                          'C:\cvs\autotest\bora-files\us101',
                          'C:\autotest\bora-files\us101' );
	} else {
            @defaults = ("/usr/lib/vmware/xkeymap/us101",
                         "/exit14/home/mts/main/bora/mks/data/xkeymap/us101");
        }
        foreach my $i (@defaults) {
            if (-r $i) {
                $keyboard_definition_file = $i;
                last;
            }
        }
        log_and_die "Could not find a default keyboard definition file, " .
            "please specify one using setKeyboardDefinition"
                if (!defined($keyboard_definition_file));
    }
    Log "Loading keyboard file $keyboard_definition_file\n";
    $ret = $vm->set_keyboard($keyboard_definition_file);

    if (!$ret) {
        script_failure();
        return $ret;
    }

    ##
    ## Locate screenshot directory
    ##
    if (!defined($screenshots_save_dir) ||
        !defined($screenshots_save_base)) {
        my ($dir, $base) =
            locate_screenshots_dir(!defined($screenshots_save_dir));
        $screenshots_save_dir = $dir if (!defined($screenshots_save_dir));
        $screenshots_save_base = $base if (!defined($screenshots_save_base));
    }

    if (!defined($screenshots_load_dir)) {
        $screenshots_load_dir = $screenshots_save_dir;
    }

    if (! defined($screenshots_load_dir) ||
        ! (-d $screenshots_load_dir && -r $screenshots_load_dir) ||
        ($record && ! -w $screenshots_load_dir)) {
        log_and_die "Error finding screenshot load directory";
    }

    if (! defined($screenshots_save_dir) ||
        ! (-d $screenshots_save_dir && -w $screenshots_save_dir) ||
        ! defined($screenshots_save_base)) {
        log_and_die "Error finding the screenshot save directory.";
    }

    Log "Screenshots will be matched against those in $screenshots_load_dir\n";
    Log "Screenshots will be saved in $screenshots_save_dir, \n";
    Log "  with base filename $screenshots_save_base if no filename is given.\n";

    $initted = 1;
    return ( $vm, $vms );
}


sub VMScriptDestroy {
    my ( $vm, $vms ) = @_;
    $vm->disconnect();
    $vms->disconnect();
}


sub load_behavior_file {
    my $filename = shift;

    my $return;

    Log "Loading behavior file $filename...\n";

    my $old_sl = $/;
    $/ = undef;
    if (!open BEHAVIOR, $filename) {
        print_error "Could not open behavior file $filename\n";
        return undef;
    }
    my $behavior_code = <BEHAVIOR>;
    $/ = $old_sl;
    close BEHAVIOR;

    unless ($return =
            eval "package main;\n" .
            "use VMware::Control::VMScript;" . $behavior_code) {
        if (!defined($return)) {
            if ($@) {
                print_error "couldn't parse behavior file $filename: $@\n";
                return undef;
            }
            print_error "couldn't use behavior file $filename: $!\n";
            return undef;
        }
        print_error "behavior file $filename returned false value\n";
    }

    Log "Behavior file $filename loaded successfully.\n";
    return $return;
}

###
# Callbacks -- eventually scripts will be able to provide their own callbacks
###

##
## Commands to set the callbacks
##

sub setCallback {
    my $callback = shift;
    my $routine = shift;

    if (!defined($callbacks{$callback})) {
        print_error "No such callback \"$callback\"\n";
        return undef;
    }

    if (!defined($routine)) {
        log_and_die "Re-setting callbacks to the default is not yet implemented.";
    }

    Log "Setting $callback callback.\n";

    $callbacks{$callback} = $routine;
}

#
# Internal callbacks
#

sub script_failure {
    my @screen_failures = @_;

    my ($err, $errstr) = $vm->get_last_error();
    print_error "VMScript failure: VMControl error $err: $errstr\n";

    if (@bug_list) {
        print_error "Bugs @bug_list are known to have occurred "
	."at this line in the past\n";
	@bug_list = ();
    }

    if (!$script_success_flag) {
        print_error "Re-entering script_failure callback -- ignoring and continuing.\n";
        return undef;
    }

    $script_success_flag = 0;
    &{$callbacks{script_failure}}($err,
                                  $errstr,
                                  $screenshots_save_dir,
                                  @screen_failures);

    croak "Script failed!";
}

sub default_script_failure_callback {
    return;
}

my $instruction_success_flag = 0;
sub instruction_success {
    if ($instruction_success_flag) {
        return;
    }

    $instruction_success_flag++;

    &{$callbacks{instruction_success}};

    $instruction_success_flag--;
}

sub default_instruction_success_callback {
#This is just an example for debugging, it is not guaranteed to work
# since caller(2) might encounter stack frames that have been optimized
# away, but this is unlikely.
    if (0 && $verbose) {
        my ($package, $filename, $line, $subroutine, $hasargs,
            $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(2);
        Log $subroutine . " (Success)\n";
    }
}

sub script_success {
    if ($script_success_flag) {
        Log "Script completed successfully.\n";
        &{$callbacks{script_success}};
    }
}

sub default_script_success_callback {
    return;
}

###
# The actual script commands
###

##
## Commands that return some value
##
sub isOn {
    my $ret = $vm->get("Status.power");

    if (!defined($ret)) {
        script_failure();
        return undef;
    }
    return ($ret eq "on");
}

sub isRecordMode {
    return $record;
}

##    
## Self contained commands
##
sub PowerOn {
    Log "PowerOn\n";
    
    my $ret = $vm->start();

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub PowerOff {
    Log "PowerOff\n";
    
    my $ret = $vm->stop(1);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub SoftShutdown {
    Log "SoftShutdown\n";
    
    my $ret = $vm->stop(0);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub Reset {
    Log "Reset\n";
    
    my $ret = $vm->reset(1);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub SoftReset {
    Log "SoftReset\n";
    
    my $ret = $vm->reset(0);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub Suspend {
    Log "Suspend\n";

    my $ret = $vm->suspend(1);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub Resume {
    Log "Resume\n";

    my $ret = $vm->resume();

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}


sub KeyDown {
    Log "KeyDown @_\n";
    
    my $ret = $vm->key_down(shift);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub KeyUp {
    Log "KeyUp @_\n";
    
    my $ret = $vm->key_up(shift);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub KeyStroke {
    Log "KeyStroke @_\n";
    
    my $ret = $vm->key_stroke(shift);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub KeyType {
    Log "KeyType @_\n";    

    my $ret = $vm->key_type(@_);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

# Sleep for n milliseconds
sub mSleep {
    my $msecs = shift(); # * $slowdown;

    Log "mSleep $msecs\n";
    
    if (!$interactive || $msecs < 1000) {
        select(undef, undef, undef, $msecs / 1000);
        return instruction_success();
    }

    my $startTime = time();
    my $timeLeft = $msecs;
    my $rin = '';
    vec($rin,fileno(STDIN),1) = 1;
    do {
        #
        # Print a message, sleep for half a second, abort loop if a key pressed
        #
        my $tLeft = sprintf "%.1f", ($timeLeft / 1000);
        if ($timeLeft < 1000) {
            print STDERR "Sleeping....................... Time Left: $tLeft seconds.     \r"
                if ($verbose);
        } else {
            print STDERR "Sleeping...hit Enter to abort.  Time Left: $tLeft seconds.     \r"
                if ($verbose);
        }

        my $rout = $rin;
        my $nfound = select($rout, undef, undef, .5);
        if ($nfound) {
            <STDIN>;
            Log "Sleep aborted by user input, continuing script execution.\n";
            return instruction_success();
        }

        print STDERR "                                                                       \r" if ($verbose);
        
        #Figure out how much time we still have to wait
        my $currentTime = time();
        my $timeElapsed = $currentTime - $startTime;
        $timeLeft = $msecs - (1000 * $timeElapsed);
    } while ($timeLeft > 0);
 
    instruction_success();
}

sub Sleep {
    my $secs = shift;
    return mSleep($secs * 1000);
}

sub config_dir_base {
    my $cfg = configFilename();

    my ($dir, $base);
    my $ssdir;

    if ( defined($cfg) && ( $cfg =~ m%^(/.+)/([^/]+)$% ||
                            $cfg =~ m%^(\w:\\.+)\\([^\\]+)$% ) ) {
        ($dir, $base) = ($1, $2);
        $base =~ s/.vmx$//;
        $base =~ s/.cfg$//;
        return ($dir, $base);
    }
    
    return undef;
}


sub locate_screenshots_dir {
    my $ok_to_create = shift;

    my ($dir, $base) = config_dir_base();
    my $ssdir;

    if ( defined($dir) && defined($base) ) {
        $ssdir = _find_or_create_dir($ok_to_create, $dir);
    } else {
        $base = "vmscreenshot";
        print_error "Unable to parse config file pathname, using \"$base\" as a base filename.\n";
    }

    if (!defined($ssdir)) {
        $ssdir = _find_or_create_dir($ok_to_create, ".");
    }

    if (!defined($ssdir)) {
        $ssdir = _find_or_create_dir($ok_to_create, "/tmp");
    }

    return ($ssdir, $base);
}

#Find or create a writable screenshots directory
sub _find_or_create_dir {
    my $ok_to_create = shift;
    my $dir = shift;

    my $ssdir = $dir . "/" . "screenshots";

    if ( -d $ssdir && -w $ssdir ) {
        return $ssdir;
    }

    if ( $ok_to_create && -d $dir && -w $dir ) {
        # This should actually be a warning
        print_error "Creating screenshot directory $ssdir\n";
        mkdir $ssdir, 0777;
        if ( -d $ssdir && -w $ssdir ) {
            return $ssdir;
        }
        print_error "Failed to create $ssdir\n";
    }

    return undef;
}
    
    
#Generate a full pathname for saving a screenshot
#If no arguments, generates a unique pathname    
sub screenshot_name {
    my $filename = shift;
    my $dir = shift;
    my $base = shift;

    if (!defined($dir)) {
        $dir = $screenshots_save_dir;
    }

    if (!defined($base)) {
        $base = $screenshots_save_base;
    }

    if (!defined($dir) || !defined($base)) {
        return undef;
    }

    if (!defined($filename)) {
        my $ssbasename = $base . "-" . strftime("%Y-%m-%d-%T", localtime);
        return _screenshot_name($dir, $ssbasename);
    } elsif (substr($filename, 0, 1) eq "/" ||
             substr($filename, 0, 2) eq "./") {
        return $filename;
    } else {
        return $dir . "/" . $filename;
    }
}

sub _screenshot_name {
    my $ssdir = shift;
    my $ssbasename = shift;

    my $ssname = $ssdir . "/" . $ssbasename . ".png";
    my $i = 2;

    while ( -f $ssname ) {
        $ssname = $ssdir . "/" . $ssbasename . "-" . $i . ".png";
        $i++;
    }

    return $ssname;
}

#Try to find an existing screenshot
sub find_screenshot {
    my $filename = shift;

    if (!defined($screenshots_load_dir)) {
        return undef;
    }

    if ( -f "$screenshots_load_dir/$filename" ) {
        return "$screenshots_load_dir/$filename";
    }

    return $filename;
}

sub SaveScreenshot {
    if ($#_ < 0) {
        push @_, screenshot_name();
    } else {
        my $filename = shift;
        my $dir = shift;
        push @_, screenshot_name($filename, $dir);
    }

    Log "SaveScreenshot @_\n";

    my $ret = $vm->save_screenshot(@_);

    if (!$ret) {
        return script_failure();
    }

    instruction_success();
    return $_[0];
}

# This routine should be called as SetBugList("21016","32120") etc. 
# Any number of bugs can be passed. As of now only WaitForScreenshot
# supports this functionality. This list is cleared by the
# immediately succeeding WaitForScreenshot call.

sub SetBugList {
    @bug_list = @_;
}	

sub WaitForScreenshot {
    my @str_args = map { if (defined($_)) { $_ } else { "undef" } } @_;
    Log "WaitForScreenshot @str_args\n";
    my $timeout = shift;

    if ($#_ < 0) {
        return script_failure();
    }

    my $ret;

    if ($record) {
        #Record the screenshot instead of matching against it
        my $filename = shift;

        print_error "Warning: RECORD-MODE, will OVERWRITE $filename!!!\n";

        if ($#_ >= 1) {
            print_error "Warning: only saving one screenshot ($filename)\n";
        }

        Sleep $timeout * $slowdown;

        return SaveScreenshot $filename, $screenshots_load_dir;
    }
    
    my @files;
    while ($_ = shift) {
        my $filename = find_screenshot($_);

        Log "  target = $filename\n" if ($verbose >= 2);

        my $mask = shift;
        if (defined($mask)) {
            $mask = find_screenshot($mask);
            Log "  (mask = $mask)\n" if ($verbose >= 2);
        }


        $ret = $vm->TargetScreenshot($filename, $mask, undef, undef, 0);

        if (!$ret) {
            $vm->TargetScreenshot(undef, undef, undef, undef, 0);
            return script_failure();
        }
        push @files, $filename, $mask;
    }

    my $startTime = time();
    my $elapsedTime = 0;
    my $needToClean = 0;

    if (!$periodicScreenshotTime) {
	#We could do no timeout here and move the timeout loop to Perl
        $ret = $vm->MatchScreenshot($timeout * $slowdown * 1000);
    } else {
        $ret = -1;
        while ($elapsedTime < ($timeout * $slowdown) && $ret < 0) {
            my $timeToMatch = ($timeout * $slowdown) - $elapsedTime;
	    if ($timeToMatch > $periodicScreenshotTime) {
	        $timeToMatch = $periodicScreenshotTime;
	    }

	    $ret = $vm->MatchScreenshot($timeToMatch * 1000);
	    $elapsedTime = time() - $startTime;

	    if ($ret < 0 && $elapsedTime < ($timeout * $slowdown)) {
	        $needToClean = 1;
		SaveScreenshot("p-" . strftime("%Y-%m-%d-%T", localtime) .
			       ".png", $screenshots_save_dir);
	    }
	}
    }

    # If the screenshot match fails, let us try sending a keystroke in
    # case this was because of a screensaver kicking in...
    if ($ret < 0) {
	# Send left control key to get rid of the screensaver
	KeyDown "Control_L";
	mSleep 250;
	KeyUp "Control_L";
	mSleep 250;

	# Wait for 10 seconds for the actual screen to show up. 
	# I guess that is long enough for the display to be restored
	# once the screensaver is gone, and short enough to make sure
	# it doesn't come back again :)
	$ret = $vm->MatchScreenshot(10000);
    }

    $vm->TargetScreenshot(undef, undef, undef, undef, 0);

    if ($ret < 0) {
        script_failure(@files);
    } else {
        my $eTime = sprintf "%.2f", $elapsedTime;
        Log "  matched Screenshot # $ret   (elapsed time $eTime seconds)\n";
        instruction_success();

	if ($needToClean) {
	    unless (opendir(SSDIR, $screenshots_save_dir)) {
	        Log "Unable to clean screenshots directory.\n";
	    } else {
	        Log "Cleaning screenshot directory..\n";
		foreach my $fileToDel (grep { /\.png$/ } readdir(SSDIR)) {
		    unless (unlink("$screenshots_save_dir/$fileToDel") == 1) {
		        Log "Couldn't remove file: $!";
		    }
		}
		unless(closedir(SSDIR)) {
		  Log "Error closing screenshots directory: $!\n";
		}
	    }
	}

	@bug_list = ();

	# sleep for 250 milliseconds to simulate a human recognizing,
        # if not reading, the screen -- guest OS installers sometimes
        # don't want a key immediately after a screen change.
	mSleep 250;
	
        return $ret;
    }
}

my ($tools_old_file, $tools_old_type);

sub ToolsInstallBegin {
    Log "ToolsInstallBegin @_\n";

    my $ret = $vm->tools_install_begin();

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub ToolsInstallEnd {
    Log "ToolsInstallEnd @_\n";

    my $ret = $vm->tools_install_end();

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub DeviceConnect {
    my @strings = map { if (!defined($_)) { ""; } else { $_; } } @_;
    Log "DeviceConnect @strings\n";

    my $ret = $vm->device_connect(@_);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub DeviceDisconnect {
    Log "DeviceDisconnect @_\n";

    my $ret = $vm->device_disconnect(@_);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}

sub Get {
#    Log "Get @_\n";

    my $ret = $vm->get(shift);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
    return $ret;
}

sub GetConfigValue {
#    Log "GetConfigValue @_\n";

    my $ret = $vm->get("Config." . shift);
    my $fail = shift;

    if (!defined($ret) && (!defined($fail) || $fail == 1)) {
        script_failure();
    } else {
        instruction_success();
    }
    return $ret;
}

sub SetConfigValues {
    Log "SetConfigValues @_\n";

    my $ret = $vm->set_config_values(@_);

    if (!$ret) {
        script_failure();
    } else {
        instruction_success();
    }
}
    
##
## Start execution
##

my @array = VMScriptInitialize;

1;


__END__

=head1 NAME

VMware::Control::VMScript - A perl module for Automated Scripting

=head1 SYNOPSIS

=head1 DESCRIPTION

TBD

=head1 AUTHORS

Brett Vasconcellos

=head1 COPYRIGHT

    (c) 2000-2001 VMware Incorporated.  All rights reserved.

=head1 VERSION

=head1 SEE ALSO

perl(1).

=cut
