Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Take a cue from ruby and cucumber, but with Perl and for system admins to write behaviour driven test cases for configuration management. Run: "./testadmin.pl ifconfig.step ifconfig.feature"
As a silly system administrator
When I run ifconfig eth0
Then the MTU must be 1500
##############################################################################
# This is the user defined callbacks. This is what you edit
our @output;
When qr{I run (\S.*)} => sub {
my ($regex, $capture) = @_;
@output = `$capture->[0]`;
chomp for @output;
};
Then qr{the MTU must be (\d+)} => sub {
my ($regex, $capture) = @_;
my @l = grep { /MTU:/ } @output;
my $mtu = $1 if $l[0] =~ /MTU:(\d+)/;
die unless $mtu == $capture->[0];
};
#!/usr/bin/perl
use strict;
use Term::ANSIColor;
# This is the section of the syntax sugar. Don't touch it
my $whenlist = [];
my $thenlist = [];
our $VERBOSE = 0;
sub When {
my $regex = shift;
my $fn = shift;
push( @$whenlist, { regex => $regex, fn => $fn } );
}
sub Then {
my $regex = shift;
my $fn = shift;
push( @$thenlist, { regex => $regex, fn => $fn } );
}
sub And {
}
sub As {
}
# Source in the step definitions
my @stepfiles = grep { /(.*\.step)/ } @ARGV;
# Remove them
@ARGV = grep { ! /\.step/ } @ARGV;
if( -d 'features' ){
my @features = glob 'features/*';
push( @stepfiles, $_ )
for( grep { /\.step/ } @features );
push( @ARGV, $_ )
for grep { ! /\.step/ } @features;
}
do $_ for @stepfiles;
LINE:while( <> ){
chomp;
my $line = $_;
if( /^When/ ){
my $testline = $line;
$testline =~ s/^When\s+//;
for( @$whenlist ){
my( $regex, $fn ) = ($_->{regex}, $_->{fn});
if( $VERBOSE ){
print STDERR colored ['yellow'], "testing [$testline] against regex [$regex]\n";
}
if( $testline =~ /$regex/i ){
print STDERR colored ['yellow'], "executing..\n"
if $VERBOSE;
&$fn( $_->{regex}, [ $1,$2,$3,$4,$5,$6,$7,$8,$9 ] );
print colored ['green'], "$line\n";
next LINE;
}
}
}
if( /^Then/ ){
my $testline = $line;
$testline =~ s/^Then\s+//;
for( @$thenlist ){
my( $regex, $fn ) = ($_->{regex}, $_->{fn});
print STDERR colored ['yellow'], "testing [$testline] against regex [$regex]\n"
if $VERBOSE;
if( $line =~ /$regex/ ){
print STDERR colored ['yellow'], "executing..\n"
if $VERBOSE;
my $rc;
eval {
$rc = &$fn( $_->{regex}, [ $1,$2,$3,$4,$5,$6,$7,$8,$9 ] );
};
if( $@ ){
print colored ['bold red'], "$line\n";
print "\n";
print colored ['bold red'], $@, "\n";
} else {
if( $rc ){
print colored ['green'], "$line\n";
} else {
print colored ['white'], "$line\n";
}
}
next LINE;
}
}
print colored ['white'], "$line\n"; # no matching Then clause
next LINE;
}
if( /^And/ ){
print colored ['green'], "$line\n";
next LINE;
}
if( /^As/ ){
print colored ['green'], "$line\n";
next LINE;
}
print colored ['white'], "$line\n";
}
As a silly system administrator
When I lookup http://localhost:80/
Then url must return 200
##############################################################################
# This is the user defined callbacks. This is what you edit
our @output;
When qr{I lookup (http.*)} => sub {
my ($regex, $capture) = @_;
@output = `curl -s -D - $capture->[0] -o /dev/null`;
chomp for @output;
};
Then qr{url must return 200} => sub {
my ($regex, $capture) = @_;
my $user = $capture->[0];
my @l = grep { /^HTTP\/1.1/ } @output;
die unless $l[0] =~ /200 OK/i;
scalar @l;
};
As a silly system administrator
When I run who
Then user pblair must be logged in
##############################################################################
# This is the user defined callbacks. This is what you edit
our @output;
Then qr{user (\S+) must be logged in} => sub {
my ($regex, $capture) = @_;
my $user = $capture->[0];
use Data::Dumper;
print STDERR Dumper( \@output ),"\n"
if $VERBOSE;
my @l = grep { /^$user/ } @output;
die if scalar @l == 0;
scalar @l;
};
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment