Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
[perl] First successful automated test run
Signed-off-by: Michael Brown <mbrown@fensystems.co.uk>
  • Loading branch information
mcb30 committed Dec 21, 2013
1 parent 5b87859 commit 9a911b6
Show file tree
Hide file tree
Showing 6 changed files with 77 additions and 39 deletions.
2 changes: 1 addition & 1 deletion perl/lib/qPXE/Dhcpd.pm
Expand Up @@ -68,7 +68,7 @@ method reserve ( Str $host, Str | ArrayRef[Str] $config ) {
} else {
$reservation .= "\n\t".$config;
}
$reservation .= "\n};\n";
$reservation .= "\n}\n";

# Generate temporary file containing the reservation
my $tempfile = File::Temp->new();
Expand Down
28 changes: 10 additions & 18 deletions perl/lib/qPXE/Test.pm
Expand Up @@ -85,7 +85,7 @@ method _build_uuid () {
The test UUID, as a colon-separated byte sequence suitable for
inclusion within C<dhcpd.conf>
(e.g. "7e:b8:64:43:84:67:e3:11:ba:6c:1a:2d:4e:ad:63:76")
(e.g. "43:64:b8:7e:67:84:11:e3:ba:6c:1a:2d:4e:ad:63:67").
=cut

Expand All @@ -98,28 +98,20 @@ has "uuid_colons" => (
);

method _build_uuid_colons () {
return join ( ":", ( map { sprintf "%02x", $_ }
unpack ( "C16", $self->uuid_bin ) ) );
}

=back
=cut

method BUILD ( HashRef $args ) {
# We can't just use unpack("C16",$self->uuid_bin) since Data::UUID
# treats UUIDs as little-endian, while iPXE (in conformance with the
# RFCs) treats them as network-endian.

# If we have an XMPP server, subscribe to our own test results. Do
# this in BUILD so that the subscription is created prior to any
# attempt to wait on a test result, without requiring an explicit
# subscription action by the test itself.
$self->subscribe() if $self->meta->has_attribute ( "xmpp" );
my $uuid_colons = lc $self->_uuidobj->to_hexstring ( $self->uuid_bin );
$uuid_colons =~ s/^0x//;
$uuid_colons =~ s/(..)(?=.)/$1:/g;
return $uuid_colons;
}

method DEMOLISH ( Bool $in_global_destruction ) {
=back
# If we have an XMPP server, unsubscribe from our own test results
$self->unsubscribe() if $self->meta->has_attribute ( "xmpp" );
}
=cut

__PACKAGE__->meta->make_immutable();

Expand Down
1 change: 0 additions & 1 deletion perl/lib/qPXE/Test/BasicDhcpHttp.pm
Expand Up @@ -23,7 +23,6 @@ method execute () {
$self->butters->domain->create();

# Wait for DUT to boot
print "Waiting for ".$self->uuid."\n";
$self->wait ( "booted", 60 );

}
Expand Down
29 changes: 10 additions & 19 deletions perl/lib/qPXE/Test/Sugar.pm
Expand Up @@ -18,6 +18,7 @@ qPXE::Test::Sugar - Syntactic sugar for constructing test cases
=cut

use qPXE::Moose ();
use qPXE::XMPP::Test;
use MooseX::Method::Signatures;
use MooseX::MarkAsMethods autoclean => 1;
use Moose::Exporter;
Expand Down Expand Up @@ -111,30 +112,20 @@ sub has_xmpp {
# Create "xmpp" builder
my $builder = "_build_xmpp";
$meta->add_method ( $builder => method () {
return $self->$xmpp->xmpp;
return qPXE::XMPP::Test->new ( xmpp => $self->$xmpp->xmpp,
uuid => $self->uuid );
} );

# Create "xmpp" attribute
# Create "xmpp" attribute. This is marked as non-lazy to ensure
# that subscription to the test results happens as soon as the test
# is created, before any actions which might generate results.
$meta->add_attribute ( "xmpp" => ( is => "ro",
isa => "qPXE::XMPP",
lazy => 1,
isa => "qPXE::XMPP::Test",
lazy => 0,
builder => $builder,
handles => [ qw ( subscribe wait
unsubscribe ) ],
init_arg => undef ) );

# Create "subscribe" method
$meta->add_method ( "subscribe" => method () {
$self->xmpp->subscribe ( $self->uuid );
} );

# Create "wait" method
$meta->add_method ( "wait" => method ( Str $id, Int $timeout ) {
return $self->xmpp->wait ( $self->uuid, $id, $timeout );
} );

# Create "unsubscribe" method
$meta->add_method ( "unsubscribe" => method () {
$self->xmpp->unsubscribe ( $self->uuid );
} );
}

=back
Expand Down
54 changes: 54 additions & 0 deletions perl/lib/qPXE/XMPP/Test.pm
@@ -0,0 +1,54 @@
package qPXE::XMPP::Test;

=head1 NAME
qPXE::XMPP::Test -
=head1 SYNOPSIS
=cut

use qPXE::Moose;
use strict;
use warnings;

has "uuid" => (
is => "ro",
isa => "Str",
required => 1,
);

has "xmpp" => (
is => "ro",
isa => "qPXE::XMPP",
required => 1,
);

method subscribe () {
$self->xmpp->subscribe ( $self->uuid );
}

method wait ( Str $id, Int $timeout ) {
return $self->xmpp->wait ( $self->uuid, $id, $timeout );
}

method unsubscribe () {
$self->xmpp->unsubscribe ( $self->uuid );
}

method BUILD ( HashRef $args ) {

# Subscribe to test results
$self->subscribe();
}

method DEMOLISH ( Bool $in_global_destruction ) {

# Unsubscribe from test results
$self->unsubscribe();
}

__PACKAGE__->meta->make_immutable();

1;
2 changes: 2 additions & 0 deletions perl/script/qpxe-demo
Expand Up @@ -11,3 +11,5 @@ my $test = qPXE::Test::BasicDhcpHttp->new ( lab => $lab );
$test->prepare();
$test->execute();
$test->cleanup();

print "Test completed successfully\n";

0 comments on commit 9a911b6

Please sign in to comment.