PITA::XML::Guest - A testing environment, typically a system image

PITA-XML documentation Contained in the PITA-XML distribution.

Index

Code Index:

NAME

Top

PITA::XML::Guest - A testing environment, typically a system image

SYNOPSIS

Top

  # A simple guest using the local Perl
  # (mostly used for test purposes)
  my $dist = PITA::XML::Guest->new(
      driver => 'Local',
      params => {},
  );

DESCRIPTION

Top

PITA::XML::Guest is an object for holding information about a testing guest environment. A PITA Guest is a container with specific operating system and hardware that contains one or more testing contexts, represented in PITA::XML by PITA::XML::Platform objects.

METHODS

Top

new

  # The most correct way to specify a guest
  my $guest1 = PITA::XML::Guest->new(
      driver => 'Qemu',
      config => {
          memory   => 256,
          snapshot => 1,
      }
  );

  # Equivalent, using shorthand.
  # Anything other that 'driver' is considered a config entry.
  my $guest = PITA::XML::Guest->new(
      driver   => 'Qemu',
      memory   => 256,
      snapshot => 1,
      );

The new constructor creates a new <guest> element.

It has a single compulsory parameter of the guest driver name, and takes optionally a set of named params to provide as creation params for the guest driver object.

Returns a new PITA::XML::Guest or throw an exception on error.

read

  $guest = PITA::XML::Guest->new( 'guest.xml' );

The read constructor loads a guest from an existing PITA::XML file.

Returns a new PITA::XML::Guest object, or throws an exception on error.

id

The id accessor returns the unique identifier of the request, if it has one. This will generally be some form of Data::UUID string.

Returns the identifier as a string, or undef if the request has not been assigned an id.

set_id

If an object does not already have an id property, the set_id method will let you assign one to the guest. Takes a valid GUID "8-4-4-4-12" string and sets the object with it, or croaks on error.

driver

The driver accessor returns the shorthand name of the driver, as it is stored in the PITA-XML xml file.

For example, if the guest uses the PITA::Guest::Driver::Qemu driver, the driver method return 'Qemu'.

driver_available

The driver_available method will check your local system to see if the driver for this guest is available in the current Perl environment.

Returns true if the driver is available, or false if not.

config

The config accessor returns the configuration for the driver.

This configuration is entirely driver-specific, and although conventions may exist, you should not rely on the contents of the configuration to have any specific meaning.

Returns a reference to a HASH containing plain scalar keys and values.

base

If the guest XML was loaded from a file via read the base method will return the directory that the XML file was loaded from.

This base directory identifies where any relative file paths should be mapped from.

files

Each guest will require zero or more file resources. In most cases, this consists of drive images or emulator configuration files.

The files method returns all existing files for this guest.

Returns a list of PITA::XML::File objects

platforms

Each guest should contain one or more testing contexts, where packages of some specific type can be automatically tested. In PITA parlance, a scheme-specific testing context is known as a Platform.

The platforms method returns all existing known platforms for this guest.

Returns a list of one of more PITA::XML::Platform objects.

If this method returns a zero-length list, then the guest may be unprocessed, and has not been 'discovered' yet.

add_file

The add_file method adds a new driver-specific file to the guest.

It takes as it's only parameter a PITA::XML::File object.

Returns true if added, or throws an exception if not passed a valid PITA::XML::File object.

add_platform

The add_platform method adds a new testing context to the guest.

In general, you should not be manually adding platform definitions to the guest unless you are implementing a driver auto-discovery mechanism for your new or custom PITA::Guest::Driver class.

That is, the PITA driver system itself will take you unprocessed guest, load it, query the guest for its platform list, and update the XML file independantly, without the help of any external system.

It takes as it's only parameter a PITA::XML::Platform object.

Returns true if added, or throws an exception if not passed a valid PITA::XML::File object.

discovered

The discovered method is a convenience method, and checks to see if platform discovery has been done on the guest, or if it is unprocessed.

Returns true if the platforms have been discovered, or false if not.

SUPPORT

Top

Bugs should be reported via the CPAN bug tracker at

http://rt.cpan.org/NoAuth/ReportBug.html?Queue=PITA-XML

For other issues, contact the author.

AUTHOR

Top

Adam Kennedy <adamk@cpan.org>, http://ali.as/

SEE ALSO

Top

PITA::XML

The Perl Image Testing Architecture (http://ali.as/pita/)

COPYRIGHT

Top

Copyright 2005 - 2011 Adam Kennedy.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the LICENSE file included with this module.

PITA-XML documentation Contained in the PITA-XML distribution. 
package PITA::XML::Guest;


use 5.006;
use strict;
use Carp                ();
use File::Spec          ();
use File::Basename      ();
use Class::Inspector    ();
use Params::Util        qw{ _INSTANCE _STRING _CLASS _HASH0 _SET0 };
use PITA::XML::Storable ();

use vars qw{$VERSION @ISA};
BEGIN {
	$VERSION = '0.51';
	@ISA     = 'PITA::XML::Storable';
}

sub xml_entity { 'guest' }





#####################################################################
# Constructor and Accessors

my %ALLOWED = (
	id     => 1,
	driver => 1,
	config => 1,
	base   => 1,
);


sub new {
	my $class = shift;
	my $self  = bless { base => undef, @_ }, $class;

	# Move the non-core options into the config hash
	unless ( _HASH0($self->{config}) ) {
		$self->{config} = {};
	}
	foreach my $k ( sort keys %$self ) {
		next if $ALLOWED{$k};
		$self->{config}->{$k} = delete $self->{$k};
	}

	# Check the object
	$self->_init;

	$self;
}


sub read {
	my $class = shift;
	my $file  = shift;
	if ( defined _STRING($file) and not -f $file ) {
		Carp::croak("XML Guest file '$file' does not exist");
	}

	# What is the directory context for the XML guest file
	my $base = File::Basename::dirname(
		File::Spec->rel2abs(
			defined(_STRING($file)) ? $file : File::Spec->curdir
		),
	);

	# Create the basic object
	my $self = bless {
		config  => {},
		base    => $base,
		@_,
	}, $class;

	### NOTE: DISABLED TILL WE FINALIZE THE SCHEMA
	# Validate the document and reset the handle
	# $class->validate( $fh );
	# $fh->seek( 0, 0 ) or Carp::croak(
	#	'Failed to reset file after validation (seek to 0)'
	#	);

	# Build the object from the file and validate
	my $fh     = PITA::XML->_FH($file);
	my $parser = XML::SAX::ParserFactory->parser(
		Handler => PITA::XML::SAXParser->new($self),
	);
        $parser->parse_file($fh);

	$self;
}

# Format-check the parameters
sub _init {
	my $self = shift;

	# Check the id, if it has one
	if ( defined $self->id ) {
		unless ( PITA::XML->_GUID($self->id) ) {
			Carp::croak('The id value is not a valid 8-4-4-4-12 GUID');
		}
	}

	# Requires a driver
	unless ( _CLASS($self->driver) ) {
		Carp::croak('Missing or invalid driver');
	}

	# Check the configuration hash
	unless ( _HASH0($self->config) ) {
		Carp::croak('Invalid, missing, or empty config');
	}

	# Optional files
	$self->{files} ||= [];
	unless ( _SET0($self->{files}, 'PITA::XML::File') ) {
		Carp::croak('Invalid files');
	}

	# Optional platforms
	$self->{platforms} ||= [];
	unless ( _SET0($self->{platforms}, 'PITA::XML::Platform') ) {
		Carp::croak('Invalid platforms');
	}

	$self;
}



sub id {
	$_[0]->{id};
}


sub set_id {
	my $self = shift;
	my $guid = PITA::XML->_GUID(shift);
	unless ( $guid ) {
		Carp::croak("Invalid GUID format");
	}
	if ( $self->id ) {
		Carp::croak("The guest already has an id value");
	}
	$self->{id} = $guid;
	return 1;
}


sub driver {
	$_[0]->{driver};
}


sub driver_available {
	my $self   = shift;
	my $driver = 'PITA::Guest::Driver::' . $self->driver;
	Class::Inspector->installed( $driver );
}


sub config {
	$_[0]->{config};
}


sub base {
	$_[0]->{base};
}


sub files {
	@{ $_[0]->{files} };
}


sub platforms {
	@{ $_[0]->{platforms} };
}


sub add_file {
	my $self = shift;
	my $file = _INSTANCE(shift, 'PITA::XML::File');
	unless ( $file ) {
		Carp::croak('Did not provide a PITA::XML::File object');
	}

	# Add it to the array
	$self->{files} ||= [];
	push @{$self->{files}}, $file;

	1;
}


sub add_platform {
	my $self     = shift;
	my $platform = _INSTANCE(shift, 'PITA::XML::Platform');
	unless ( $platform ) {
		Carp::croak('Did not provide a PITA::XML::Platform object');
	}

	# Add it to the array
	$self->{platforms} ||= [];
	push @{$self->{platforms}}, $platform;

	1;
}





#####################################################################
# Main Methods


sub discovered {
	!! $_[0]->platforms;
}

1;