#---------------------------------------------------------------------
# $Header: /Perl/OlleDB/t/Helpers/assemblies.pl 10    08-08-17 22:32 Sommar $
#
# This is file that is C<require> by several test scripts to create
# two CLT types in the current database.
#
# $History: assemblies.pl $
# 
# *****************  Version 10  *****************
# User: Sommar       Date: 08-08-17   Time: 22:32
# Updated in $/Perl/OlleDB/t/Helpers
# Need to have a wait loop to drop assembly types, as SQL Server defers
# dropping of table parameters.
#
# *****************  Version 9  *****************
# User: Sommar       Date: 08-04-07   Time: 23:11
# Updated in $/Perl/OlleDB/t/Helpers
# Updated the UTF8StringMax assembly.
#
# *****************  Version 8  *****************
# User: Sommar       Date: 08-03-09   Time: 23:46
# Updated in $/Perl/OlleDB/t/Helpers
# Make it possible to only create some types for short execution time.
#
# *****************  Version 7  *****************
# User: Sommar       Date: 08-02-24   Time: 21:58
# Updated in $/Perl/OlleDB/t/Helpers
# Exclude temp tables from the cleanup, as that could be inaccessible
# table variables.
#
# *****************  Version 6  *****************
# User: Sommar       Date: 07-09-16   Time: 22:40
# Updated in $/Perl/OlleDB/t/Helpers
# Added a assembly with a large UDT.
#
# *****************  Version 5  *****************
# User: Sommar       Date: 05-10-29   Time: 22:08
# Updated in $/Perl/OlleDB/t/Helpers
#
# *****************  Version 4  *****************
# User: Sommar       Date: 05-07-25   Time: 0:42
# Updated in $/Perl/OlleDB/t/Helpers
# Added cleanup procedure.
#
# *****************  Version 3  *****************
# User: Sommar       Date: 05-07-20   Time: 22:42
# Updated in $/Perl/OlleDB/t/Helpers
#
# *****************  Version 2  *****************
# User: Sommar       Date: 05-07-17   Time: 18:04
# Updated in $/Perl/OlleDB/t/Helpers
#
# *****************  Version 1  *****************
# User: Sommar       Date: 05-07-16   Time: 17:14
# Created in $/Perl/OlleDB/t/Helpers
#---------------------------------------------------------------------

use strict;

sub delete_assembly{
    my($X, $assemblyname) = @_;

    $X->sql(<<SQLEND);
DECLARE \@assembly_id int,
        \@typename    sysname,
        \@list        nvarchar(MAX),
        \@i           int

SELECT \@assembly_id = assembly_id
FROM   sys.assemblies
WHERE  name = '$assemblyname'

IF \@assembly_id IS NOT NULL
BEGIN
   SELECT TOP 1 \@typename = name
   FROM   sys.assembly_types
   WHERE  assembly_id = \@assembly_id

   IF \@typename IS NOT NULL
   BEGIN
      SELECT \@i = 20

      WHILE \@i > 0
      BEGIN
         SELECT \@list = substring(tablelist, 1, datalength(tablelist)/2 - 1)
         FROM   (SELECT quotename(schema_name(o.schema_id)) + '.' +
                       quotename(o.name) + ',' AS [text()]
                 FROM   sys.objects o
                 WHERE  EXISTS (SELECT *
                                FROM  sys.columns c
                                JOIN  sys.types t  ON c.user_type_id = t.user_type_id
                                WHERE t.name = \@typename
                                  AND c.object_id = o.object_id)
                   AND  o.type = 'U'
                 FOR XML PATH('')) AS Dummy(tablelist)

         IF nullif(\@list, '') IS NULL
            BREAK

         -- There may be a table parameter lingering, that has not been
         IF \@list LIKE '%#[0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F][0-9A-F]%'
         BEGIN
            WAITFOR DELAY '00:00:01'
            SELECT \@i = \@i - 1
            CONTINUE
         END

         EXEC('DROP TABLE ' + \@list)
         BREAK
      END

      SELECT \@list = substring(proclist, 1, datalength(proclist)/2 - 1)
      FROM   (SELECT quotename(schema_name(o.schema_id)) + '.' +
                     quotename(o.name) + ',' AS [text()]
              FROM   sys.objects o
              WHERE  EXISTS (SELECT *
                             FROM  sys.parameters p
                             JOIN  sys.types t ON p.user_type_id = t.user_type_id
                             WHERE t.name = \@typename
                               AND p.object_id = o.object_id)
                AND  o.type = 'P'
              FOR XML PATH('')) AS Dummy(proclist)
      IF nullif(\@list, '') IS NOT NULL
         EXEC('DROP PROCEDURE ' + \@list)

      SELECT \@list = substring(funclist, 1, datalength(funclist)/2 - 1)
      FROM   (SELECT quotename(schema_name(o.schema_id)) + '.' +
                     quotename(o.name) + ',' AS [text()]
              FROM   sys.objects o
              WHERE  EXISTS (SELECT *
                             FROM  sys.parameters p
                             JOIN  sys.types t ON p.user_type_id = t.user_type_id
                             WHERE t.name = \@typename
                               AND p.object_id = o.object_id)
                AND  o.type = 'FN'
              FOR XML PATH('')) AS Dummy(funclist)
      IF nullif(\@list, '') IS NOT NULL
         EXEC('DROP FUNCTION ' + \@list)

      SELECT \@typename = quotename(\@typename)
      EXEC ('DROP TYPE ' + \@typename)
   END
   DROP ASSEMBLY $assemblyname
END
SQLEND
}

sub create_one_udt {
    my ($X, $typename, $assemblyname, $definition) = @_;
    delete_assembly($X, $assemblyname);
    return if not defined $typename;
$X->sql(<<SQLEND);
CREATE ASSEMBLY $assemblyname FROM $definition
CREATE TYPE [$typename] EXTERNAL NAME $assemblyname.[OlleDBtest.$assemblyname]
SQLEND
}

sub create_the_udts {
    my ($X, $cmplxname, $pointname, $stringname, $stringmaxname) = @_;

    my $sqlver = (split(/\./, $X->{SQL_version}))[0];
    my $save_binary = $X->{BinaryAsStr};
    $X->{BinaryAsStr} = 'x';

    create_one_udt($X, $cmplxname, 'OlleComplexInteger',
                   '[encoded data, 13314 characters]');
    create_one_udt($X, $pointname, 'OllePoint',
                   '[encoded data, 15362 characters]');
    create_one_udt($X, $stringname, 'OlleString',
                   '[encoded data, 15362 characters]');

    if ($sqlver >= 10) {
       create_one_udt($X, $stringmaxname, 'OlleStringMax',
                      '[encoded data, 15362 characters]');
    }

    $X->{BinaryAsStr} = $save_binary;

}

sub delete_the_udts {
   my ($X) = @_;

   delete_assembly($X, 'OlleComplexInteger');
   delete_assembly($X, 'OllePoint');
   delete_assembly($X, 'OlleString');
   delete_assembly($X, 'OlleStringMax');
}

1;
