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", "" );
  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*AUTH\s*=\s*(\S.*)$/ && do {
 120     @auth = ( "--user", $1 );
 121   };
 122
 123   $line =~ /^\s*DATA\s*=\s*(\S.*)$/ && do {
 124     my $basename = $1;
 125     if ( defined($suite) ) {
 126       if ( -e "tests/$suite/$basename.data" ) {
 127         $datafile="tests/$suite/$basename.data";
 128       }
 129       elsif ( -e "tests/$suite/$basename" ) {
 130         $datafile="tests/$suite/$basename";
 131       }
 132
 133     }
 134     elsif ( -e "$basename.data" ) {
 135       $datafile="$basename.data";
 136     }
 137     elsif ( -e $basename ) {
 138       $datafile=$basename;
 139     }
 140     else {
 141       die "Can't find DATA file $basename or $basename.data";
 142     }
 143   };
 144
 145   $line =~ /^BEGINDATA\s*$/ && do {
 146     $data_binary = "";
 147     $state = "DATA";
 148   };
 149
 150   $line =~ /^GETSQL\s*=\s*(\S.*)$/ && do {
 151     $sql_variable = $1;
 152     $sql_statement = "";
 153     $state = "SQL";
 154   };
 155
 156   $line =~ /^DOSQL\s*$/ && do {
 157     $sql_statement = "";
 158     $state = "DOSQL";
 159   };
 160
 161   $line =~ /^REPLACE\s*=\s*(\S)(.*)$/ && do {
 162     my $separator = $1;
 163     $2 =~ /^([^$separator]*)$separator([^$separator]*)$separator$/ && do {
 164       push @$replacements, { 'pattern' => $1, 'replacement' => $2 };
 165     };
 166   };
 167
 168   $line =~ /^QUERY\s*$/ && do {
 169     $sql_statement = "";
 170     $state = "QUERY";
 171   };
 172
 173   $line =~ /^\s*TYPE\s*=\s*(\S.*)$/ && do {
 174     if ( $1 eq "HEAD" ) {
 175       $is_head_request = 1;
 176     }
 177     else {
 178       push @arguments, "--request", $1;
 179     }
 180   };
 181
 182   $line =~ /^\s*HEADER\s*=\s*(\S.*)$/ && do {
 183     my $arg = $1;
 184     $arg =~ s{regression.host}{$webhost};
 185     $arg =~ s{alternate.host}{$althost};
 186     push @arguments, "--header", $arg;
 187   };
 188
 189   $line =~ /^\s*URL\s*=\s*(\S.*)$/ && do {
 190     $url=$1;
 191     $url =~ s{regression.host}{$webhost};
 192     $url =~ s{alternate.host}{$althost};
 193   };
 194
 195   $line =~ /^\s*SCRIPT\s*=\s*(\S.*)$/ && do {
 196     $script=$1;
 197     $script =~ s{regression.host}{$webhost};
 198     $script =~ s{alternate.host}{$althost};
 199     push @scripts, $script;
 200   };
 201
 202 }
 203
 204 if ( !defined($url) && !defined($script) ) {
 205   print <<EOERROR ;
 206 The .test file must contain either a URL or a SCRIPT.
 207 EOERROR
 208   exit (2);
 209 }
 210
 211 push @arguments, "--head" if ( $is_head_request );
 212
 213 push @arguments, @auth;
 214
 215 if ( -f $datafile ) {
 216   push @arguments, "--data-binary", "\@$datafile";
 217 }
 218 elsif ( defined($data_binary) ) {
 219   push @arguments, "--data-binary", $data_binary;
 220 }
 221 else {
 222   undef($datafile);
 223 }
 224
 225
 226 if ( defined($url) ) {
 227   push @arguments, $url;
 228
 229   print STDERR join " ", "curl", @arguments, "\n" if ( $debug );
 230
 231   open RESULTS, "-|", "curl", @arguments;
 232   while( <RESULTS> ) {
 233     my $line = $_;
 234     foreach my $replacement ( @$replacements ) {
 235       $line =~ s/$replacement->{'pattern'}/$replacement->{'replacement'}/;
 236     }
 237     print $line;
 238   }
 239 }
 240
 241 if ( defined($script) ) {
 242   foreach $script ( @scripts ) {
 243     open RESULTS, "-|", $script;
 244     while( <RESULTS> ) {
 245       my $line = $_;
 246       foreach my $replacement ( @$replacements ) {
 247         $line =~ s/$replacement->{'pattern'}/$replacement->{'replacement'}/;
 248       }
 249       print $line;
 250     }
 251   }
 252 }
 253
 254 if ( defined(@{$queries}) && @{$queries} ) {
 255   opendb() unless defined($dbh);
 256   print "\n";
 257   print STDERR "Processing special queries\n" if ( $debug );
 258   foreach $sql_statement ( @$queries ) {
 259     # run SQL statement and dump results, into array of hashes
 260     my $results = $dbh->selectall_arrayref($sql_statement, { Slice => {} } );
 261     if ( $dbh->err ) {
 262       print $dbh->errstr, "\n";
 263       next;
 264     }
 265     foreach my $row ( @$results ) {
 266       print "Query result ================================================\n" if ( $debug );
 267       my $sep = "";
 268       foreach my $name ( sort keys %$row ) {
 269         my $value = $row->{$name};
 270         $value = 'NULL' unless ( defined($value) );
 271         printf("%17.17s: >%s<\n", $name, $value );
 272       }
 273       print "\n";
 274     }
 275   }
 276 }
 277
 278 exit(0);
 279
 280
 281 =item do_sql( $sql_statement )
 282 Queries the database using the specified statement and
 283 ignores the result.
 284 =cut
 285 sub do_sql {
 286   my $sql = shift;
 287
 288   opendb() unless defined($dbh);
 289   $dbh->do($sql);
 290   if ( $dbh->err ) {
 291     print $dbh->errstr, "\n";
 292     return;
 293   }
 294   print "SQL executed successfully.\n";
 295   print $sql, "\n";
 296 }
 297
 298
 299 =item get_sql_value( $sql_variable, $sql_values, $sql_statement )
 300 Queries the database using the specified statement and puts
 301 the first column of the first row returned into the
 302 hash referenced $sql_values->{$sql_variable} for replacement
 303 later in the parsing process.
 304 =cut
 305 sub get_sql_value {
 306   my $varname = shift;
 307   my $values  = shift;
 308   my $sql = shift;
 309
 310   opendb() unless defined($dbh);
 311   my $results = $dbh->selectall_arrayref($sql);
 312   if ( $dbh->err ) {
 313     print $dbh->errstr, "\n";
 314     return;
 315   }
 316   print STDERR "RESULT for $varname is ", $results->[0][0], "\n" if ( $debug );
 317   $values->{$varname} = (defined($results->[0][0]) ? $results->[0][0] : "");
 318 }
 319
 320 =item opendb()
 321 Opens the database connection to the global $dbh handle.
 322 Note that the standard PostgreSQL environment variables will also work
 323 with DBD::Pg.
 324 =cut
 325 sub opendb {
 326   $dsn = "dbi:Pg:dbname=$dsn";
 327   $dbh = DBI->connect($dsn, $dbuser, $dbpass, { AutoCommit => 1 } ) or die "Can't connect to database $dsn";
 328 }
 329
 330
 331 sub usage {
 332   print <<EOERROR ;
 333
 334 Usage:
 335   dav_test [DB opts] [--suite <testsuite> --case <testname>] | [--test <filename>]
 336
 337 This program will read the file 'tests/<testsuite>/<testname>.test
 338 and follow the instructions there.
 339
 340 The following options are available for controlling the database, for
 341 those test cases which might require it:
 342   --dsn <database>[;port=NNNN][;host=example.com]
 343   --dbuser <user>
 344   --dbpass <password>
 345
 346
 347 The test instructions will include lines defining the test like:
 348 =================================================
 349 # This is an example
 350 URL=http://mycaldav/caldav.php/andrew/
 351 HEADER=Depth: 0
 352 HEADER=Content-type: text/xml
 353 TYPE=PROPFIND
 354 HEAD
 355 DATA=OTHERTEST
 356 # This will let you use ##somename## for this value after this
 357 GETSQL=somename
 358 SELECT column FROM table WHERE criteria
 359 ENDSQL
 360 # The data can be included in line
 361 BEGINDATA
 362 ... data content ...
 363 ENDDATA
 364 # The result could be some SQL output
 365 QUERY
 366 SELECT something, or, other FROM table ...
 367 ENDQUERY
 368
 369 REPLACE=/pattern/replacement/options
 370 =================================================
 371
 372 URL      The URL to request from.
 373 HEADER   An additional header for the request
 374 TYPE     The type of request (e.g. GET/PUT/POST/REPORT/...)
 375 HEAD     Whether to include the headers in the recorded response
 376 VERBOSE  Whether to provide the full request / response headers.
 377 DATA     The name of a different test in this suite to use data from.
 378 REPLACE  A perl regex replacement to post-process the result through.
 379
 380 Additionally, if a file 'tests/<testsuite>/<testname>.data' exists
 381 the contents of that file will be sent in the body of the request.
 382
 383 EOERROR
 384   exit(1);
 385 }