#!/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 = ();
my $replacements = ();

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 =~ /^REPLACE\s*=\s*(\S)(.*)$/ && do {
    my $separator = $1;
    $2 =~ /^([^$separator]*)$separator([^$separator]*)$separator$/ && do {
      push @$replacements, { 'pattern' => $1, 'replacement' => $2 };
    };
  };

  $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> ) {
  my $line = $_;
  foreach my $replacement ( @$replacements ) {
    $line =~ s/$replacement->{'pattern'}/$replacement->{'replacement'}/;
  }
  print $line;
}

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} = (defined($results->[0][0]) ? $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);
}