#!/usr/bin/perl
#***************************************************************************************************
# *
# SiliconBrain.pm: reusable siliconBrain perl snippets. *
# *
#***************************************************************************************************
#***************************************************************************************************
# *
# Copyright (C) 2003, 2004 Joerg Kunze *
# *
# This file is part of siliconBrain. *
# *
# siliconBrain is free software; you can redistribute it and/or modify *
# it under the terms of the GNU General Public License as published by *
# the Free Software Foundation; either version 2 of the License, or *
# (at your option) any later version. *
# *
# siliconBrain is distributed in the hope that it will be useful, *
# but WITHOUT ANY WARRANTY; without even the implied warranty of *
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
# GNU General Public License for more details. *
# *
# You should have received a copy of the GNU General Public License *
# along with this program; if not, write to the Free Software *
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *
# *
#***************************************************************************************************
require 'assert.pl';
$siliconBrainPath = $ENV{siliconBrainPath};
#***************************************************************************************************
# *
# editFile: *
# *
#***************************************************************************************************
sub editFile {
$fileName = shift;
$editCommands = shift;
open editorSession, "|ed $fileName 2> /dev/null > /dev/null";
print editorSession "1\n$editCommands\nw\nq\n";
close editorSession;
}
#***************************************************************************************************
# *
# testProbe: *
# *
#***************************************************************************************************
sub testProbe {
return "probe: 1234566642\n";
}
#***************************************************************************************************
# *
# testPrint: *
# *
#***************************************************************************************************
sub testPrint {
if( $secondPrint ) {
print " (" . (time() - $siliconBrainTime) . " Seconds)\n";
} else {
$secondPrint = 1;
}
print "${main::scriptName}: @_";
$siliconBrainTime = time();
}
#***************************************************************************************************
# *
# testAssert: *
# *
#***************************************************************************************************
sub testAssert {
assert( @_ );
}
#***************************************************************************************************
# *
# testFileExists: *
# *
#***************************************************************************************************
sub testFileExists {
for $file (@_) {
main::assert( '-f $file', $file );
}
}
#***************************************************************************************************
# *
# testMake: *
# *
#***************************************************************************************************
sub testMake {
$makeTitle = shift;
$makeResult = `make @_ 2>&1`;
$returnCode = $? >> 8;
if( $returnCode ) {
testPrint( "make \"", $makeTitle, @_, "\" return'ed $returnCode.\n" );
print $makeResult;
exit 42;
}
}
#***************************************************************************************************
# *
# testFile: *
# *
#***************************************************************************************************
sub testFile {
$fileToCheck = shift;
unless( open fileToCheck, "$fileToCheck" ) {
testPrint "testFile: Unable to open \"$fileToCheck\".";
testPrint "Error message: \"$!\".";
exit 42;
}
@fileContents = ();
while( <fileToCheck> ) {
#----------------------------------------------------------------------------------------------#
# some commands (like man) use the double printing of a char to print it in bold. This is done #
# by printing the char, then print Ctrl-H to go one back, then print the char a second time. #
# Programs like xterm interpret this sequence by high lighting the char. TO be able to grep #
# text we delete sequences of <char> followed by a Ctrl-H. #
#----------------------------------------------------------------------------------------------#
s/.\cH//g;
#----------------------------------------------------------------------------------------------#
# some commands (again like man) put spaces inbetween words to block align the output. The #
# placement of these spaces is not predictable and depend for examp,e on the geometry of the #
# output device. To make output grep'able we shrink multiple occurances of a space to a #
# single space. #
#----------------------------------------------------------------------------------------------#
s/ +/ /g;
push @fileContents, $_;
}
#--------------------------------------------------------------#
# and finaly execute the herd of test, our caller has provided #
#--------------------------------------------------------------#
foreach $checkExpression (@_) {
if( ! eval( $checkExpression . ', @fileContents' ) ) {
print "\"$checkExpression\" not valid for \"$fileToCheck\".\n";
exit 43;
}
}
}
#***************************************************************************************************
# *
# testCommand: *
# *
#***************************************************************************************************
sub testCommand {
$command = shift;
#--------------------------------------------------------------------------------#
# a '!' (logical not) before the command name indicates, that we expect an error #
#--------------------------------------------------------------------------------#
if( substr( $command, 0, 1 ) eq "!" ) {
$command = substr( $command, 1 );
$errorExpected = 1;
} else {
$errorExpected = 0;
}
open stderrSave, ">&STDERR";
open STDERR, "/dev/null";
unless( open COMMAND, "$command |" ) {
testPrint "Unable to open \"$command\".";
testPrint "Error message: \"$!\".";
exit 42;
}
@commandOutput = ();
while( <COMMAND> ) {
#----------------------------------------------------------------------------------------------#
# some commands (like man) use the double printing of a char to print it in bold. This is done #
# by printing the char, then print Ctrl-H to go one back, then print the char a second time. #
# Programs like xterm interpret this sequence by high lighting the char. TO be able to grep #
# text we delete sequences of <char> followed by a Ctrl-H. #
#----------------------------------------------------------------------------------------------#
s/.\cH//g;
#----------------------------------------------------------------------------------------------#
# some commands (again like man) put spaces inbetween words to block align the output. The #
# placement of these spaces is not predictable and depend for examp,e on the geometry of the #
# output device. To make output grep'able we shrink multiple occurances of a space to a #
# single space. #
#----------------------------------------------------------------------------------------------#
s/ +/ /g;
push @commandOutput, $_;
}
$errorMessage = $!;
close COMMAND;
close STDERR;
open STDERR, ">&stderrSave";
$returnCode = $? >> 8;
if( $returnCode && !$errorExpected ) {
testPrint( "\"$command\" return'ed: $returnCode." );
testPrint( "Error message: \"$errorMessage\"." );
exit 42;
}
if( !$returnCode && $errorExpected ) {
testPrint( "\"$command\" return'ed: $returnCode." );
testPrint( "Error message: But an error has been expected." );
exit 42;
}
#--------------------------------------------------------------#
# and finaly execute the herd of test, our caller has provided #
#--------------------------------------------------------------#
foreach $checkExpression (@_) {
if( ! eval( $checkExpression . ', @commandOutput' ) ) {
print "\"$checkExpression\" not valid for \"$command\".\n";
exit 43;
}
}
}
#***************************************************************************************************
# *
# export: *
# *
#***************************************************************************************************
package SiliconBrain;
use Exporter;
@ISA = ('Exporter');
@EXPORT_OK = qw( );
#***************************************************************************************************
# *
# general: *
# *
#***************************************************************************************************
$siliconBrainRelease = '$siliconBrainRelease: 0.2.3 $';
$siliconBrainRcsIdentifier = '$Id: SiliconBrain.pm,v 1.15 2004/12/14 23:31:26 joerg Exp $';
$siliconBrainSaveStamp = '$siliconBrainSaveStamp: 2004/12/14 22:24:47, Joerg Kunze$';
$scriptName = "SiliconBrain.pm";
# $Log: SiliconBrain.pm,v $
# Revision 1.15 2004/12/14 23:31:26 joerg
# published for new release 0.2.3
#
# Revision 1.14 2004/12/14 23:17:05 joerg
# published for new release 0.2.2
#
# Revision 1.13 2004/12/14 22:42:22 joerg
# allFiles: all sources have a Log CVS keyword at the end now.
#