The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#---------------------------------------------------------------------
# $Header: /Perl/OlleDB/t/B_filestream.t 7     12-09-23 22:50 Sommar $
#
# Tests for OpenSqlFilestream.
#
# $History: B_filestream.t $
# 
# *****************  Version 7  *****************
# User: Sommar       Date: 12-09-23   Time: 22:50
# Updated in $/Perl/OlleDB/t
# Added test for earlier providers, since we now check this in code.
# 
# *****************  Version 6  *****************
# User: Sommar       Date: 11-08-07   Time: 23:34
# Updated in $/Perl/OlleDB/t
# Added better test of the $alloclen parameter.
# 
# *****************  Version 5  *****************
# User: Sommar       Date: 08-05-04   Time: 18:47
# Updated in $/Perl/OlleDB/t
# Don't run the test without SQLNCLI10.
#
# *****************  Version 4  *****************
# User: Sommar       Date: 08-05-02   Time: 0:44
# Updated in $/Perl/OlleDB/t
# Changed the check for whether FILESTREAM is enabled.
#
# *****************  Version 3  *****************
# User: Sommar       Date: 08-02-17   Time: 18:01
# Updated in $/Perl/OlleDB/t
# Added allocation length to the last call to OpenSqlFilestream.
#
# *****************  Version 2  *****************
# User: Sommar       Date: 07-12-02   Time: 21:41
# Updated in $/Perl/OlleDB/t
#
# *****************  Version 1  *****************
# User: Sommar       Date: 07-11-26   Time: 22:45
# Created in $/Perl/OlleDB/t
#---------------------------------------------------------------------

use strict;
use Win32::SqlServer qw(:DEFAULT :consts);
use File::Basename qw(dirname);
use Win32API::File;

require &dirname($0) . '\testsqllogin.pl';


$^W = 1;
$| = 1;

my $X = testsqllogin();
my ($sqlver) = split(/\./, $X->{SQL_version});
my $x86 = ($ENV{'PROCESSOR_ARCHITECTURE'} eq 'x86');

if ($sqlver < 10) {
   print "1..0 # Skipped: FileStream not available on SQL 2005 and earlier.\n";
   exit;
}

# If we have an old provider, check that we produces an error message.
if ($X->{Provider} < PROVIDER_SQLNCLI10) {
   print "1..1\n";
   eval('$X->OpenSqlFilestream("undef", FILESTREAM_READ, "undef")');
   if ($@ =~ /must use the SQLNCLI10 provider/) {
       print "ok 1\n";
   }
   else {
       print "not ok 1 # $@\n"; 
   }
   exit;
}


my $fs_config = sql_one(<<SQLEND, SCALAR);
SELECT value_in_use FROM sys.configurations WHERE name = 'filestream access level'
SQLEND
if ($fs_config < 2) {
   print "1..0 # Skipped: Instance not configured for remote filestream access.\n";
   exit;
}

my $username = sql_one("SELECT SYSTEM_USER", SCALAR);
if ($username !~ /\\/) {
   print "1..0 # Skipped: filestream requires Windows authentication.\n";
   exit;
}

print "1..9\n";

# Create a test database with a filestream filegroup.
$X->sql(<<'SQLEND');
CREATE DATABASE Olle$DB
ALTER DATABASE Olle$DB ADD FILEGROUP fs CONTAINS FILESTREAM
SQLEND

# We need to know path for data file to determine where to create the
# filestream container.
my $dbpath = $X->sql_one(<<'SQLEND', SCALAR);
SELECT physical_name
FROM   Olle$DB.sys.database_files
WHERE  file_id = 1
SQLEND
$dbpath =~ s/\.mdf$//;
$dbpath .= ".datadir";

# Now we can add the file group.
$X->sql(<<SQLEND);
ALTER DATABASE Olle\$DB ADD FILE
    (NAME = 'fs', FILENAME = '$dbpath') TO FILEGROUP fs
SQLEND

# This is our test strings.
my $yksi  = "Somliga säger att somliga somrar somnar somliga.\n" x 2000;
my $kaksi = "Nelly Nilsson nöjer sig numera näppeligen med nio nötter till natten.\n" x 2000;
my $kolme = "Handlar Hansons halta höna har haft hosta hela halva hösten.\n" x 1000;
my $negy  = "Elva elaka elefanter erövrade Enköping\n";

# Move to the database and create a table with three rows in it.
$X->sql('USE Olle$DB');
$X->sql(<<'SQLEND', {'@yksi' => ['varchar', $yksi], '@kolme' => ['varchar', $kolme]});
CREATE TABLE fstest (guid uniqueidentifier          NOT NULL ROWGUIDCOL UNIQUE,
                     name varchar(23)               NOT NULL PRIMARY KEY,
                     data varbinary(MAX) FILESTREAM NULL)

INSERT fstest (guid, name, data)
   VALUES(newid(), 'Yksi', cast(@yksi AS varbinary(MAX))),
         (newid(), 'Kaksi', 0x),
         (newid(), 'Kolme', cast(@kolme AS varbinary(MAX)))

SQLEND

# Testing set up. Set up message handling, so that the script does not stop
# on errors.
$X->{ErrInfo}{MaxSeverity} = 16;
$X->{ErrInfo}{PrintLines} = 17;
$X->{ErrInfo}{PrintText} = 17;
$X->{ErrInfo}{PrintMsg} = 17;
$X->{ErrInfo}{SaveMessages} = 1;



# We're all set for testing. Let's try reading data.
my ($path, $context, $fh, $buffer, $ret);
$X->{BinaryAsStr} = 1;
($path, $context) = $X->sql(<<SQLEND, LIST, SINGLEROW);
BEGIN TRANSACTION
SELECT data.PathName(), get_filestream_transaction_context()
FROM   fstest
WHERE  name = 'Yksi'
SQLEND

$fh = $X->OpenSqlFilestream($path, FILESTREAM_READ, $context);
if ($fh > 0) {
   print "ok 1\n";
}
else {
   print "not ok 1\n";
}

$ret = Win32API::File::ReadFile($fh, $buffer, 200000, [], []);
if ($ret) {
   print "ok 2\n";
}
else {
   print "not ok 2 # ReadFile failed with $^E\n";
}

if ($buffer eq $yksi) {
   print "ok 3\n";
}
else {
   print "not ok 3\n";
}

# Close this transaction.
Win32API::File::CloseHandle($fh);
$X->sql('ROLLBACK TRANSACTION');

# Try writing.
$X->{BinaryAsStr} = 0;
($path, $context) = $X->sql(<<SQLEND, LIST, SINGLEROW);
BEGIN TRANSACTION
SELECT data.PathName(), get_filestream_transaction_context()
FROM   fstest
WHERE  name = 'Kaksi'
SQLEND

# The option is just to test that options work.
$fh = $X->OpenSqlFilestream($path, FILESTREAM_WRITE, $context,
                            SQL_FILESTREAM_OPEN_FLAG_NO_WRITE_THROUGH);
if ($fh > 0) {
   print "ok 4\n";
}
else {
   print "not ok 4\n";
}

$ret = Win32API::File::WriteFile($fh, $kaksi, 0, [], []);
if ($ret) {
   print "ok 5\n";
}
else {
   print "not ok 5 # WriteFile failed with $^E\n";
}
# Close this transaction.
Win32API::File::CloseHandle($fh);
$X->sql('COMMIT TRANSACTION');

# And check the data.
$buffer = $X->sql_one(<<SQLEND, SCALAR);
SELECT convert(varchar(MAX), data)
FROM   fstest
WHERE  name = 'Kaksi'
SQLEND
if ($buffer eq $kaksi) {
   print "ok 6\n";
}
else {
   print "not ok 6\n";
}


$X->{BinaryAsStr} = 'x';
($path, $context) = $X->sql(<<SQLEND, LIST, SINGLEROW);
BEGIN TRANSACTION
SELECT data.PathName(), get_filestream_transaction_context()
FROM   fstest
WHERE  name = 'Kolme'
SQLEND

# Test some more flags and also a reasonable value for $alloclen.
$fh = $X->OpenSqlFilestream($path, FILESTREAM_READWRITE, $context,
                            SQL_FILESTREAM_OPEN_FLAG_RANDOM_ACCESS, 10000);
if ($fh > 0) {
   print "ok 7\n";
}
else {
   print "not ok 7\n";
}


# Close this transaction.
Win32API::File::CloseHandle($fh);
$X->sql('COMMIT TRANSACTION');

undef $buffer;

# And check the data.
$buffer = $X->sql_one(<<SQLEND, SCALAR);
SELECT convert(varchar(MAX), data)
FROM   fstest
WHERE  name = 'Kolme'
SQLEND
if ($buffer eq '') {
   print "ok 8\n";
}
else {
   print "not ok 8\n";
}

($path, $context) = $X->sql(<<SQLEND, LIST, SINGLEROW);
BEGIN TRANSACTION
SELECT data.PathName(), get_filestream_transaction_context()
FROM   fstest
WHERE  name = 'Kolme'
SQLEND

# To test that the $alloclen parameter really works we ask for so much space
# that it just has to fail.
my $alloclen;
if ($x86) {
	$alloclen = {High => 20000, Low => 0};
}
else {
    $alloclen = int(80E12);
}

$fh = $X->OpenSqlFilestream($path, FILESTREAM_READWRITE, $context, 0,
                            $alloclen);
if ($fh > 0) {
   print "not ok 9  # You don't have a 80 TB disk, do you?\n";
}
else {
   my $errmsg = $X->{ErrInfo}{Messages}[0];
   if ($errmsg and
	   $errmsg->{Source} eq 'OpenSqlFilestream' and
       $errmsg->{Errno} = -112 and
	   $errmsg->{Severity} = 16) { 
       print "ok 9\n";
   }
   else {
	   print "not ok 9\n";
   }	  
}

# Close this transaction.
Win32API::File::CloseHandle($fh);
$X->sql('COMMIT TRANSACTION');

undef $buffer;


$X->sql('USE master');
$X->sql('DROP DATABASE Olle$DB');

exit;