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"

ifconfig.feature

As a silly system administrator
When I run ifconfig eth0
Then the MTU must be 1500

ifconfig.step

##############################################################################

# 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];
};

testadmin.pl

#!/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";
}

urltest.feature

As a silly system administrator
When I lookup http://localhost:80/
Then url must return 200

urltest.step

##############################################################################

# 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;
};

w.feature

As a silly system administrator
When I run who
Then user pblair must be logged in

w.step

##############################################################################

# 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;
};