testing/dav_test

   1 #!/usr/bin/perl -w
   2 #
   3 # Run a test
   4 #
   5
   6 use strict;
   7
   8 use DBI;
   9 use Getopt::Long qw(:config permute);  # allow mixed args.
  10
  11 # Options variables
  12 my $debug  = 0;
  13 my $dsn    = "davical";
  14 my $dbuser = "";
  15 my $dbpass = "";
  16 my $webhost = 'mycaldav';
  17 my $althost = 'myempty';
  18 my $testdef;
  19 my $suite;
  20 my $case;
  21 my $helpmeplease = 0;
  22
  23 my $dbadir = $0;
  24 $dbadir =~ s{/[^/]*$}{};
  25 my $patchdir = $dbadir . "/patches";
  26
  27
  28 GetOptions ('debug!'    => \$debug,
  29             'dsn=s'     => \$dsn,
  30             'dbuser=s'  => \$dbuser,
  31             'dbpass=s'  => \$dbpass,
  32             'webhost=s' => \$webhost,
  33             'althost=s' => \$althost,
  34             'test=s'    => \$testdef,
  35             'suite=s'   => \$suite,
  36             'case=s'    => \$case,
  37             'help'      => \$helpmeplease  );
  38
  39 usage() if ( $helpmeplease || ((!defined($suite) || !defined($case)) && !defined($testdef)));
  40
  41 my $dbh;
  42
  43
  44 my @arguments = ( "--basic", "--proxy", "", "--insecure", "--raw" );
  45 push @arguments, "--silent"  unless ( $debug );
  46 push @arguments, "--verbose" if ( $debug );
  47
  48 my $url;
  49 my $script;
  50 my @scripts = ( );
  51 my $is_head_request = 0;
  52 my @auth = ( "--user", "user1:user1" );
  53
  54 if ( !defined($testdef) ) {
  55   $testdef = "tests/$suite/$case.test";
  56 }
  57
  58 my $datafile = $testdef;
  59 $datafile =~ s{\.test$}{};
  60 push @arguments, "--header", 'X-DAViCal-Testcase: '.$datafile;
  61 $datafile .= '.data';
  62
  63 my $state = "";
  64 my $data_binary;
  65
  66 my $sql_variable = "";
  67 my $sql_statement = "";
  68 my $sql_values = {};
  69 my $queries = ();
  70 my $replacements = ();
  71
  72
  73 open( TEST, '<', $testdef ) or die "Can't open '$testdef'";
  74 while( <TEST> ) {
  75   my $line = $_;
  76
  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;
  81   }
  82
  83   if ( $state ne "" ) {
  84     if ( /^END$state$/ ) {
  85       if ( $state eq "SQL" ) {
  86         get_sql_value( $sql_variable, $sql_values, $sql_statement );
  87       }
  88       elsif ( $state eq "DOSQL" ) {
  89         do_sql( $sql_statement );
  90       }
  91       elsif ( $state eq "QUERY" ) {
  92         push @$queries, $sql_statement;
  93       }
  94       $state = "";
  95     }
  96     elsif ( $state eq "DATA" ) {
  97       $data_binary .= $line;
  98     }
  99     elsif ( $state eq "SQL" || $state eq "QUERY" || $state eq "DOSQL" ) {
 100       $sql_statement .= $line;
 101     }
 102     next;
 103   }
 104
 105   /^\s*(#|$)/ && next;
 106
 107   $line =~ /^\s*HEAD\s*(#|$|=)/ && do {
 108     push @arguments, "--include";
 109   };
 110
 111   $line =~ /^\s*VERBOSE\s*(#|$|=)/ && do {
 112     push @arguments, "--verbose";
 113   };
 114
 115   $line =~ /^\s*NOAUTH\s*(#|$|=)/ && do {
 116     @auth = ();
 117   };
 118
 119   $line =~ /^\s*DIGEST\s*(#|$|=)/ && do {
 120     push @arguments, "--digest";
 121     @auth = ( "--user", $1 );
 122   };
 123
 124   $line =~ /^\s*AUTH\s*=\s*(\S.*)$/ && do {
 125     @auth = ( "--user", $1 );
 126   };
 127
 128   $line =~ /^\s*DATA\s*=\s*(\S.*)$/ && do {
 129     my $basename = $1;
 130     if ( defined($suite) ) {
 131       if ( -e "tests/$suite/$basename.data" ) {
 132         $datafile="tests/$suite/$basename.data";
 133       }
 134       elsif ( -e "tests/$suite/$basename" ) {
 135         $datafile="tests/$suite/$basename";
 136       }
 137
 138     }
 139     elsif ( -e "$basename.data" ) {
 140       $datafile="$basename.data";
 141     }
 142     elsif ( -e $basename ) {
 143       $datafile=$basename;
 144     }
 145     else {
 146       die "Can't find DATA file $basename or $basename.data";
 147     }
 148   };
 149
 150   $line =~ /^BEGINDATA\s*$/ && do {
 151     $data_binary = "";
 152     $state = "DATA";
 153   };
 154
 155   $line =~ /^GETSQL\s*=\s*(\S.*)$/ && do {
 156     $sql_variable = $1;
 157     $sql_statement = "";
 158     $state = "SQL";
 159   };
 160
 161   $line =~ /^DOSQL\s*$/ && do {
 162     $sql_statement = "";
 163     $state = "DOSQL";
 164   };
 165
 166   $line =~ /^REPLACE\s*=\s*(\S)(.*)$/ && do {
 167     my $separator = $1;
 168     $2 =~ /^([^$separator]*)$separator([^$separator]*)$separator$/ && do {
 169       push @$replacements, { 'pattern' => $1, 'replacement' => $2 };
 170     };
 171   };
 172
 173   $line =~ /^QUERY\s*$/ && do {
 174     $sql_statement = "";
 175     $state = "QUERY";
 176   };
 177
 178   $line =~ /^\s*TYPE\s*=\s*(\S.*)$/ && do {
 179     if ( $1 eq "HEAD" ) {
 180       $is_head_request = 1;
 181     }
 182     else {
 183       push @arguments, "--request", $1;
 184     }
 185   };
 186
 187   $line =~ /^\s*HEADER\s*=\s*(\S.*)$/ && do {
 188     my $arg = $1;
 189     $arg =~ s{regression.host}{$webhost};
 190     $arg =~ s{alternate.host}{$althost};
 191     push @arguments, "--header", $arg;
 192   };
 193
 194   $line =~ /^\s*URL\s*=\s*(\S.*)$/ && do {
 195     $url=$1;
 196     $url =~ s{regression.host}{$webhost};
 197     $url =~ s{alternate.host}{$althost};
 198   };
 199
 200   $line =~ /^\s*SCRIPT\s*=\s*(\S.*)$/ && do {
 201     $script=$1;
 202     $script =~ s{regression.host}{$webhost};
 203     $script =~ s{alternate.host}{$althost};
 204     push @scripts, $script;
 205   };
 206
 207 }
 208
 209 if ( !defined($url) && !defined($script) ) {
 210   print <<EOERROR ;
 211 The .test file must contain either a URL or a SCRIPT.
 212 EOERROR
 213   exit (2);
 214 }
 215
 216 push @arguments, "--head" if ( $is_head_request );
 217
 218 push @arguments, @auth;
 219
 220 if ( -f $datafile ) {
 221   push @arguments, "--data-binary", "\@$datafile";
 222 }
 223 elsif ( defined($data_binary) ) {
 224   push @arguments, "--data-binary", $data_binary;
 225 }
 226 else {
 227   undef($datafile);
 228 }
 229
 230
 231 if ( defined($url) ) {
 232   push @arguments, $url;
 233
 234   print STDERR join " ", "curl", @arguments, "\n" if ( $debug );
 235
 236   open RESULTS, "-|", "curl", @arguments;
 237   while( <RESULTS> ) {
 238     my $line = $_;
 239     foreach my $replacement ( @$replacements ) {
 240       $line =~ s/$replacement->{'pattern'}/$replacement->{'replacement'}/;
 241     }
 242     print $line;
 243   }
 244 }
 245
 246 if ( defined($script) ) {
 247   foreach $script ( @scripts ) {
 248     open RESULTS, "-|", $script;
 249     while( <RESULTS> ) {
 250       my $line = $_;
 251       foreach my $replacement ( @$replacements ) {
 252         $line =~ s/$replacement->{'pattern'}/$replacement->{'replacement'}/;
 253       }
 254       print $line;
 255     }
 256   }
 257 }
 258
 259 if ( defined($queries) && @{$queries} ) {
 260   opendb() unless defined($dbh);
 261   print "\n";
 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 => {} } );
 266     if ( $dbh->err ) {
 267       print $dbh->errstr, "\n";
 268       next;
 269     }
 270     foreach my $row ( @$results ) {
 271       print "Query result ================================================\n" if ( $debug );
 272       my $sep = "";
 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 );
 277       }
 278       print "\n";
 279     }
 280   }
 281 }
 282
 283 exit(0);
 284
 285
 286 =item do_sql( $sql_statement )
 287 Queries the database using the specified statement and
 288 ignores the result.
 289 =cut
 290 sub do_sql {
 291   my $sql = shift;
 292
 293   opendb() unless defined($dbh);
 294   $dbh->do($sql);
 295   if ( $dbh->err ) {
 296     print $dbh->errstr, "\n";
 297     return;
 298   }
 299   print "SQL executed successfully.\n";
 300   print $sql, "\n";
 301 }
 302
 303
 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.
 309 =cut
 310 sub get_sql_value {
 311   my $varname = shift;
 312   my $values  = shift;
 313   my $sql = shift;
 314
 315   opendb() unless defined($dbh);
 316   my $results = $dbh->selectall_arrayref($sql);
 317   if ( $dbh->err ) {
 318     print $dbh->errstr, "\n";
 319     return;
 320   }
 321   print STDERR "RESULT for $varname is ", $results->[0][0], "\n" if ( $debug );
 322   $values->{$varname} = (defined($results->[0][0]) ? $results->[0][0] : "");
 323 }
 324
 325 =item opendb()
 326 Opens the database connection to the global $dbh handle.
 327 Note that the standard PostgreSQL environment variables will also work
 328 with DBD::Pg.
 329 =cut
 330 sub opendb {
 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'");
 334 }
 335
 336
 337 sub usage {
 338   print <<EOERROR ;
 339
 340 Usage:
 341   dav_test [DB opts] [--suite <testsuite> --case <testname>] | [--test <filename>]
 342
 343 This program will read the file 'tests/<testsuite>/<testname>.test
 344 and follow the instructions there.
 345
 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]
 349   --dbuser <user>
 350   --dbpass <password>
 351
 352
 353 The test instructions will include lines defining the test like:
 354 =================================================
 355 # This is an example
 356 URL=http://mycaldav/caldav.php/andrew/
 357 HEADER=Depth: 0
 358 HEADER=Content-type: text/xml
 359 TYPE=PROPFIND
 360 HEAD
 361 DATA=OTHERTEST
 362 # This will let you use ##somename## for this value after this
 363 GETSQL=somename
 364 SELECT column FROM table WHERE criteria
 365 ENDSQL
 366 # The data can be included in line
 367 BEGINDATA
 368 ... data content ...
 369 ENDDATA
 370 # The result could be some SQL output
 371 QUERY
 372 SELECT something, or, other FROM table ...
 373 ENDQUERY
 374
 375 REPLACE=/pattern/replacement/options
 376 =================================================
 377
 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.
 385
 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.
 388
 389 EOERROR
 390   exit(1);
 391 }