9 use Getopt
::Long
qw(:config permute); # allow mixed args.
16 my $webhost = 'mycaldav';
17 my $althost = 'myempty';
24 $dbadir =~ s{/[^/]*$}{};
25 my $patchdir = $dbadir . "/patches";
28 GetOptions
('debug!' => \
$debug,
30 'dbuser=s' => \
$dbuser,
31 'dbpass=s' => \
$dbpass,
32 'webhost=s' => \
$webhost,
33 'althost=s' => \
$althost,
34 'test=s' => \
$testdef,
37 'help' => \
$helpmeplease );
39 usage
() if ( $helpmeplease || ((!defined($suite) || !defined($case)) && !defined($testdef)));
44 my @arguments = ( "--basic", "--proxy", "", "--insecure", "--raw" );
45 push @arguments, "--silent" unless ( $debug );
46 push @arguments, "--verbose" if ( $debug );
51 my $is_head_request = 0;
52 my @auth = ( "--user", "user1:user1" );
54 if ( !defined($testdef) ) {
55 $testdef = "tests/$suite/$case.test";
58 my $datafile = $testdef;
59 $datafile =~ s{\.test$}{};
60 push @arguments, "--header", 'X-DAViCal-Testcase: '.$datafile;
66 my $sql_variable = "";
67 my $sql_statement = "";
70 my $replacements = ();
73 open( TEST
, '<', $testdef ) or die "Can't open '$testdef'";
77 # Do any variable replcements we have so far
78 foreach my $variable ( keys %{$sql_values} ) {
79 my $value = $sql_values->{$variable};
80 $line =~ s/##$variable##/$value/g;
84 if ( /^END$state$/ ) {
85 if ( $state eq "SQL" ) {
86 get_sql_value
( $sql_variable, $sql_values, $sql_statement );
88 elsif ( $state eq "DOSQL" ) {
89 do_sql
( $sql_statement );
91 elsif ( $state eq "QUERY" ) {
92 push @
$queries, $sql_statement;
96 elsif ( $state eq "DATA" ) {
97 $data_binary .= $line;
99 elsif ( $state eq "SQL" || $state eq "QUERY" || $state eq "DOSQL" ) {
100 $sql_statement .= $line;
107 $line =~ /^\s*HEAD\s*(#|$|=)/ && do {
108 push @arguments, "--include";
111 $line =~ /^\s*VERBOSE\s*(#|$|=)/ && do {
112 push @arguments, "--verbose";
115 $line =~ /^\s*NOAUTH\s*(#|$|=)/ && do {
119 $line =~ /^\s*DIGEST\s*(#|$|=)/ && do {
120 push @arguments, "--digest";
121 @auth = ( "--user", $1 );
124 $line =~ /^\s*AUTH\s*=\s*(\S.*)$/ && do {
125 @auth = ( "--user", $1 );
128 $line =~ /^\s*DATA\s*=\s*(\S.*)$/ && do {
130 if ( defined($suite) ) {
131 if ( -e
"tests/$suite/$basename.data" ) {
132 $datafile="tests/$suite/$basename.data";
134 elsif ( -e
"tests/$suite/$basename" ) {
135 $datafile="tests/$suite/$basename";
139 elsif ( -e
"$basename.data" ) {
140 $datafile="$basename.data";
142 elsif ( -e
$basename ) {
146 die "Can't find DATA file $basename or $basename.data";
150 $line =~ /^BEGINDATA\s*$/ && do {
155 $line =~ /^GETSQL\s*=\s*(\S.*)$/ && do {
161 $line =~ /^DOSQL\s*$/ && do {
166 $line =~ /^REPLACE\s*=\s*(\S)(.*)$/ && do {
168 $2 =~ /^([^$separator]*)$separator([^$separator]*)$separator$/ && do {
169 push @
$replacements, { 'pattern' => $1, 'replacement' => $2 };
173 $line =~ /^QUERY\s*$/ && do {
178 $line =~ /^\s*TYPE\s*=\s*(\S.*)$/ && do {
179 if ( $1 eq "HEAD" ) {
180 $is_head_request = 1;
183 push @arguments, "--request", $1;
187 $line =~ /^\s*HEADER\s*=\s*(\S.*)$/ && do {
189 $arg =~ s{regression.host}{$webhost};
190 $arg =~ s{alternate.host}{$althost};
191 push @arguments, "--header", $arg;
194 $line =~ /^\s*URL\s*=\s*(\S.*)$/ && do {
196 $url =~ s{regression.host}{$webhost};
197 $url =~ s{alternate.host}{$althost};
200 $line =~ /^\s*SCRIPT\s*=\s*(\S.*)$/ && do {
202 $script =~ s{regression.host}{$webhost};
203 $script =~ s{alternate.host}{$althost};
204 push @scripts, $script;
209 if ( !defined($url) && !defined($script) ) {
211 The .test file must contain either a URL or a SCRIPT.
216 push @arguments, "--head" if ( $is_head_request );
218 push @arguments, @auth;
220 if ( -f
$datafile ) {
221 push @arguments, "--data-binary", "\@$datafile";
223 elsif ( defined($data_binary) ) {
224 push @arguments, "--data-binary", $data_binary;
231 if ( defined($url) ) {
232 push @arguments, $url;
234 print STDERR
join " ", "curl", @arguments, "\n" if ( $debug );
236 open RESULTS
, "-|", "curl", @arguments;
239 foreach my $replacement ( @
$replacements ) {
240 $line =~ s/$replacement->{'pattern'}/$replacement->{'replacement'}/;
246 if ( defined($script) ) {
247 foreach $script ( @scripts ) {
248 open RESULTS
, "-|", $script;
251 foreach my $replacement ( @
$replacements ) {
252 $line =~ s/$replacement->{'pattern'}/$replacement->{'replacement'}/;
259 if ( defined($queries) && @
{$queries} ) {
260 opendb
() unless defined($dbh);
262 print STDERR
"Processing special queries\n" if ( $debug );
263 foreach $sql_statement ( @
$queries ) {
264 # run SQL statement and dump results, into array of hashes
265 my $results = $dbh->selectall_arrayref($sql_statement, { Slice
=> {} } );
267 print $dbh->errstr, "\n";
270 foreach my $row ( @
$results ) {
271 print "Query result ================================================\n" if ( $debug );
273 foreach my $name ( sort keys %$row ) {
274 my $value = $row->{$name};
275 $value = 'NULL' unless ( defined($value) );
276 printf("%17.17s: >%s<\n", $name, $value );
286 =item do_sql( $sql_statement )
287 Queries the database using the specified statement and
293 opendb
() unless defined($dbh);
296 print $dbh->errstr, "\n";
299 print "SQL executed successfully.\n";
304 =item get_sql_value( $sql_variable, $sql_values, $sql_statement )
305 Queries the database using the specified statement and puts
306 the first column of the first row returned into the
307 hash referenced $sql_values->{$sql_variable} for replacement
308 later in the parsing process.
315 opendb
() unless defined($dbh);
316 my $results = $dbh->selectall_arrayref($sql);
318 print $dbh->errstr, "\n";
321 print STDERR
"RESULT for $varname is ", $results->[0][0], "\n" if ( $debug );
322 $values->{$varname} = (defined($results->[0][0]) ?
$results->[0][0] : "");
326 Opens the database connection to the global $dbh handle.
327 Note that the standard PostgreSQL environment variables will also work
331 $dsn = "dbi:Pg:dbname=$dsn";
332 $dbh = DBI
->connect($dsn, $dbuser, $dbpass, { AutoCommit
=> 1 } ) or die "Can't connect to database $dsn";
333 $dbh->do("SET TIMEZONE TO 'Pacific/Auckland'");
341 dav_test [DB opts] [--suite <testsuite> --case <testname>] | [--test <filename>]
343 This program will read the file 'tests/<testsuite>/<testname>.test
344 and follow the instructions there.
346 The following options are available for controlling the database, for
347 those test cases which might require it:
348 --dsn <database>[;port=NNNN][;host=example.com]
353 The test instructions will include lines defining the test like:
354 =================================================
356 URL=http://mycaldav/caldav.php/andrew/
358 HEADER=Content-type: text/xml
362 # This will let you use ##somename## for this value after this
364 SELECT column FROM table WHERE criteria
366 # The data can be included in line
370 # The result could be some SQL output
372 SELECT something, or, other FROM table ...
375 REPLACE=/pattern/replacement/options
376 =================================================
378 URL The URL to request from.
379 HEADER An additional header for the request
380 TYPE The type of request (e.g. GET/PUT/POST/REPORT/...)
381 HEAD Whether to include the headers in the recorded response
382 VERBOSE Whether to provide the full request / response headers.
383 DATA The name of a different test in this suite to use data from.
384 REPLACE A perl regex replacement to post-process the result through.
386 Additionally, if a file 'tests/<testsuite>/<testname>.data' exists
387 the contents of that file will be sent in the body of the request.