davical/testing/dav_test

276 lines
6.5 KiB
Perl
Executable File

#!/usr/bin/perl -w
#
# Run a test
#
use strict;
use DBI;
use Getopt::Long qw(:config permute); # allow mixed args.
# Options variables
my $debug = 0;
my $dbname = "rscds";
my $dbport = 5432;
my $dbuser = "";
my $dbpass = "";
my $dbhost = "";
my $suite;
my $test;
my $helpmeplease = 0;
my $dbadir = $0;
$dbadir =~ s#/[^/]*$##;
my $patchdir = $dbadir . "/patches";
GetOptions ('debug!' => \$debug,
'dbname=s' => \$dbname,
'dbuser=s' => \$dbuser,
'dbpass=s' => \$dbpass,
'dbport=s' => \$dbport,
'dbhost=s' => \$dbhost,
'suite=s' => \$suite,
'case=s' => \$test,
'help' => \$helpmeplease );
usage() if ( $helpmeplease || !defined($suite) || !defined($test));
############################################################
# Open database connection. Note that the standard PostgreSQL
# environment variables will also work with DBD::Pg.
############################################################
my $dsn = "dbi:Pg:dbname=$dbname";
$dsn .= ";host=$dbhost" if ( "$dbhost" ne "" );
$dsn .= ";port=$dbport" if ( $dbport != 5432 );
my $dbh = DBI->connect($dsn, $dbuser, $dbpass, { AutoCommit => 0 } ) or die "Can't connect to database $dbname";
my @arguments = ( "--basic", "--proxy", "", "--silent" );
push @arguments, "--verbose" if ( defined($ARGV[2]) );
my $url;
my $is_head_request = 0;
my @auth = ( "--user", "user1:user1" );
my $datafile = "tests/$suite/$test.data";
my $state = "";
my $data_binary;
my $sql_variable = "";
my $sql_statement = "";
my $sql_values = {};
my $queries = ();
open( TEST, '<', "tests/$suite/$test.test" ) or die "Can't open 'tests/$suite/$test.test'";
while( <TEST> ) {
my $line = $_;
# Do any variable replcements we have so far
foreach my $variable ( keys %{$sql_values} ) {
my $value = $sql_values->{$variable};
$line =~ s/##$variable##/$value/g;
}
if ( $state ne "" ) {
if ( /^END$state$/ ) {
if ( $state eq "SQL" ) {
get_sql_value( $sql_variable, $sql_values, $sql_statement );
}
elsif ( $state eq "SQL" || $state eq "QUERY" ) {
push @$queries, $sql_statement;
}
$state = "";
}
elsif ( $state eq "DATA" ) {
$data_binary .= $line;
}
elsif ( $state eq "SQL" || $state eq "QUERY" ) {
$sql_statement .= $line;
}
next;
}
/^\s*(#|$)/ && next;
$line =~ /^\s*HEAD\s*(#|$|=)/ && do {
push @arguments, "--include";
};
$line =~ /^\s*VERBOSE\s*(#|$|=)/ && do {
push @arguments, "--verbose";
};
$line =~ /^\s*NOAUTH\s*(#|$|=)/ && do {
@auth = ();
};
$line =~ /^\s*AUTH\s*=\s*(\S.*)$/ && do {
@auth = ( "--user", $1 );
};
$line =~ /^\s*DATA\s*=\s*(\S.*)$/ && do {
$datafile="tests/$suite/$1.data";
};
$line =~ /^BEGINDATA\s*$/ && do {
$data_binary = "";
$state = "DATA";
};
$line =~ /^GETSQL\s*=\s*(\S.*)$/ && do {
$sql_variable = $1;
$sql_statement = "";
$state = "SQL";
};
$line =~ /^QUERY\s*$/ && do {
$sql_statement = "";
$state = "QUERY";
};
$line =~ /^\s*TYPE\s*=\s*(\S.*)$/ && do {
if ( $1 eq "HEAD" ) {
$is_head_request = 1;
}
else {
push @arguments, "--request", $1;
}
};
$line =~ /^\s*HEADER\s*=\s*(\S.*)$/ && do {
push @arguments, "--header", $1;
};
$line =~ /^\s*URL\s*=\s*(\S.*)$/ && do {
$url=$1;
};
}
if ( !defined($url) ) {
print <<EOERROR ;
The .test file must contain a URL. It may also contain a TYPE line (to
specify the request type, such as PROPFIND, MKCOL, PUT etc) and it may
contain a number of HEADER lines to specify additional headers to send
along with the request.
EOERROR
exit (2);
}
push @arguments, "--head" if ( $is_head_request );
push @arguments, @auth;
if ( -f $datafile ) {
push @arguments, "--data-binary", "\@$datafile";
}
elsif ( defined($data_binary) ) {
push @arguments, "--data-binary", $data_binary;
}
else {
undef($datafile);
}
push @arguments, $url;
print STDERR join " ", "curl", @arguments, "\n" if ( $debug );
open RESULTS, "-|", "curl", @arguments;
while( <RESULTS> ) {
print;
}
if ( defined(@{$queries}) && @{$queries} ) {
print STDERR "Processing special queries\n" if ( $debug );
foreach $sql_statement ( @$queries ) {
# run SQL statement and dump results
my $results = $dbh->selectall_arrayref($sql_statement);
foreach my $row ( @$results ) {
print STDERR "Processing results row\n" if ( $debug );
my $sep = "";
foreach my $column ( @$row ) {
print $sep, $column;
$sep = " --- ";
}
print "\n";
}
}
}
exit(0);
=item get_sql_value( $sql_variable, $sql_values, $sql_statement )
Queries the database using the specified statement and puts
the first column of the first row returned into the
hash referenced $sql_values->{$sql_variable} for replacement
later in the parsing process.
=cut
sub get_sql_value {
my $varname = shift;
my $values = shift;
my $sql = shift;
my $results = $dbh->selectall_arrayref($sql);
print STDERR "RESULT for $varname is ", $results->[0][0], "\n" if ( $debug );
$values->{$varname} = $results->[0][0];
}
sub usage {
print <<EOERROR ;
Usage: dav_test [DB opts] --suite <testsuite> --case <testname>
This program will read the file 'tests/<testsuite>/<testname>.test
and follow the instructions there.
The following options are available for controlling the database, for
those test cases which might require it:
--dbname <database>
--dbuser <user>
--dbpass <password>
--dbport <port>
--dbhost <host>
The test instructions will include lines defining the test like:
=================================================
# This is an example
URL=http://mycaldav/caldav.php/andrew/
HEADER=Depth: 0
HEADER=Content-type: text/xml
TYPE=PROPFIND
HEAD
DATA=OTHERTEST
# This will let you use ##somename## for this value after this
GETSQL=somename
SELECT column FROM table WHERE criteria
ENDSQL
# The data can be included in line
BEGINDATA
... data content ...
ENDDATA
# The result could be some SQL output
QUERY
SELECT something, or, other FROM table ...
ENDQUERY
=================================================
URL The URL to request from.
HEADER An additional header for the request
TYPE The type of request (e.g. GET/PUT/POST/REPORT/...)
HEAD Whether to include the headers in the recorded response
VERBOSE Whether to provide the full request / response headers.
DATA The name of a different test in this suite to use data from.
Additionally, if a file 'tests/<testsuite>/<testname>.data' exists
the contents of that file will be sent in the body of the request.
EOERROR
exit(1);
}