Allow changing directory when running a script

This also involves changing scripts to be run at the time they're mentioned,
not accruing them to run at the end.
This commit is contained in:
Andrew Ruthven 2024-03-03 21:21:07 +13:00
parent 0c9e0d6a87
commit c5b3e385b3
2 changed files with 36 additions and 19 deletions

View File

@ -10,6 +10,7 @@ use File::Copy;
use DBI;
use Getopt::Long qw(:config permute); # allow mixed args.
use File::pushd;
# Options variables
my $debug = 0;
@ -57,8 +58,9 @@ push @arguments, "--silent" unless ( $debug );
push @arguments, "--verbose" if ( $debug );
my $url;
my $script;
my @scripts = ( );
my $script; # Not neede as global, used as flag.
my $script_dir;
my $is_head_request = 0;
my @auth = ( "--user", "user1:user1" );
# Allow easier pasting of tests on the command line.
@ -249,6 +251,7 @@ while( <TEST> ) {
}
};
# HTTP headers to send with curl
$line =~ /^\s*HEADER\s*=\s*(\S.*)$/ && do {
my $arg = $1;
$arg =~ s{regression.host}{$webhost};
@ -257,6 +260,7 @@ while( <TEST> ) {
push @arguments, "--header", $arg;
};
# URL to use with curl
$line =~ /^\s*URL\s*=\s*(\S.*)$/ && do {
$url=$1;
$url =~ s{regression.host}{$webhost};
@ -264,12 +268,32 @@ while( <TEST> ) {
$url =~ s{alternate.host}{$althost};
};
# The directory to run the next SCRIPT in.
$line =~ /^\s*SCRIPT_DIR\s*=\s*(\S.*)$/ && do {
$script_dir = $1;
};
# Run this SCRIPT, collect the output.
$line =~ /^\s*SCRIPT\s*=\s*(\S.*)$/ && do {
$script=$1;
$script =~ s{regression.host}{$webhost};
$script =~ s{regression_ldap.host}{$ldaphost};
$script =~ s{alternate.host}{$althost};
push @scripts, $script;
my $dir = pushd($script_dir)
if defined $script_dir;
open RESULTS, "-|", $script;
while( <RESULTS> ) {
my $line = $_;
foreach my $replacement ( @$replacements ) {
$line =~ s/$replacement->{'pattern'}/$replacement->{'replacement'}/;
}
print $line;
}
$script_dir = undef;
};
$line =~ /^\s*STATIC\s*=\s*(.*?)\s*$/ && do {
@ -323,19 +347,6 @@ if ( defined($url) ) {
}
}
if ( defined($script) ) {
foreach $script ( @scripts ) {
open RESULTS, "-|", $script;
while( <RESULTS> ) {
my $line = $_;
foreach my $replacement ( @$replacements ) {
$line =~ s/$replacement->{'pattern'}/$replacement->{'replacement'}/;
}
print $line;
}
}
}
if ( defined($queries) && @{$queries} ) {
opendb() unless defined($dbh);
print "\n";
@ -345,10 +356,15 @@ if ( defined($queries) && @{$queries} ) {
foreach $sql_statement ( @$queries ) {
# run SQL statement and dump results, into array of hashes
my $results = $dbh->selectall_arrayref($sql_statement, { Slice => {} } );
if ( $dbh->err ) {
print $dbh->errstr, "\n";
next;
} elsif (! defined $results) {
print "No results from SQL query\n";
next;
}
foreach my $row ( @$results ) {
warn "Query result ================================================\n"
if $debug;

View File

@ -51,14 +51,15 @@ echo "LANG=en_NZ.UTF-8" > /etc/default/locale
###
packages="libdbd-pg-perl libyaml-perl postgresql-client postgresql
curl xmlstarlet netcat-openbsd libtest-www-mechanize-perl"
curl xmlstarlet netcat-openbsd libtest-www-mechanize-perl
libfile-pushd-perl"
if [[ $mode =~ "latestphp" ]]; then
# PHP pgsql package is built from source, needs libpq-dev.
packages="$packages libpq-dev"
else
# The latestphp images already have some of these available, and others need
# to installed in another method.
# The latestphp images already have some of these available, and others
# need to installed in another method.
packages="$packages libapache2-mod-php php php-cli php-pgsql php-xml
php-curl"
fi