#--------------------------------------------------------------------- # $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(<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(<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(<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(<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(<{BinaryAsStr} = 'x'; ($path, $context) = $X->sql(<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(<sql(< 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;