The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;

=head1 NAME

HighLevel test suite

=head1 DESCRIPTION

Test Win32::MSI::HighLevel

=cut

BEGIN {
    use lib '../../..';    # For 'CPAN' folder layout
    use lib '../lib';    # For dev folder layout
    use Win32::API;

    if ($^O ne 'MSWin32') {
        plan (skip_all => "Windows only module. Tests irrelevant on $^O");
    } elsif (
        !Win32::API->new ("kernel32", 'LoadLibrary', "P", 'I')->Call ('msi'))
    {
        plan (skip_all =>
                "msi.dll required - Windows Installer must be installed");
    } else {
        plan (tests => 84);
    }

    use_ok ("Win32::MSI::HighLevel");
}

my $filename = 'delme.msi';

# Basic create and open database tests.
unlink $filename;
ok (
    my $msi = Win32::MSI::HighLevel->new (
        -file => $filename,
        -mode => Win32::MSI::HighLevel::Common::kMSIDBOPEN_CREATE ()
    ),
    'Create a new .msi file in transacted mode'
   );
$msi = 0;    # Destroy object

unlink $filename;
ok (
    $msi = Win32::MSI::HighLevel->new (
        -file => $filename,
        -mode => Win32::MSI::HighLevel::Common::kMSIDBOPEN_CREATEDIRECT ()
    ),
    'Create a new .msi file in direct mode'
   );
$msi = 0;    # Destroy object

ok (
    $msi = Win32::MSI::HighLevel->new (
        -file => $filename,
        -mode => Win32::MSI::HighLevel::Common::kMSIDBOPEN_DIRECT ()
    ),
    'Open existing .msi file in direct mode'
   );
$msi = 0;    # Destroy object

ok (
    $msi = Win32::MSI::HighLevel->new (
        -file => $filename,
        -mode => Win32::MSI::HighLevel::Common::kMSIDBOPEN_READONLY ()
    ),
    'Open existing .msi file in read only mode'
   );
$msi = 0;    # Destroy object

ok (
    $msi = Win32::MSI::HighLevel->new (
        -file => $filename,
        -mode => Win32::MSI::HighLevel::Common::kMSIDBOPEN_TRANSACT ()
    ),
    'Open existing .msi file in transacted mode'
   );

print "Create a Feature table, populate it, and check contents\n";
is ('Feature', $msi->createTable (-table => 'Feature'), 'Create Feature table');
is (
    'Complete',
    $msi->addFeature (-name => 'Complete', -Title => 'Full install'),
    'Add Complete feature to Feature table'
   );
mustDie (
    sub {$msi->addFeature ();},
    'Win32::MSI::HighLevel::addFeature requires a -name parameter',
    'Add empty feature fails'
);
ok ($msi->writeTables (), 'Write updated tables to disk');

is (0, $msi->exportTable ('Feature', 'Tables'), 'Export Feature table');

checkTableEntry (
    "Feature\tFeature_Parent\tTitle\tDescription\tDisplay\tLevel\tDirectory_\tAttributes",
    "s38\tS38\tL64\tL255\tI2\ti2\tS72\ti2",
    "Feature\tFeature",
    "Complete\t\tFull install\t\t1\t3\t\t0",
);

print "Create a Property table, populate it, and check contents\n";
is (
    'Property',
    $msi->createTable (-table => 'Property'),
    'Create Property table'
   );
is (
    'Wibble',
    $msi->addProperty (-Property => 'Wibble', -Value => 'wobble'),
    'Add Wibble property to Property table'
   );
mustDie (
    sub {$msi->addProperty ();},
    'Win32::MSI::HighLevel::addProperty requires a -Property parameter',
    'Add empty property fails'
);
ok ($msi->writeTables (), 'Write updated tables to disk');
is (0, $msi->exportTable ('Property', 'Tables'), 'Export Property table');

checkTableEntry ("Property\tValue", "s72\tl0", "Property\tProperty",
    "Wibble\twobble",);

print "Create a Directory table, populate it, and check contents\n";
is (
    'Directory',
    $msi->createTable (-table => 'Directory'),
    'Create Directory table'
   );
is (
    'TARGETDIR',
    $msi->addDirectory (
        -Directory        => 'TARGETDIR',
        -Directory_Parent => undef,
        -DefaultDir       => 'SrcDir|SourceDir'
    ),
    'Add root entry to Directory table'
   );
is (
    'Root',
    $msi->addDirectory (
        -Directory        => 'Root',
        -Directory_Parent => 'TARGETDIR',
    ),
    'Add root entry to Directory table'
   );
is (
    'Dobbie',
    $msi->addDirectory (
        -Directory_Parent => 'TARGETDIR',
        -Directory        => 'Dobbie',
        -source           => 'wibble~1|Wibble Plonk',
        -target           => 'target~1|Target Dir'
    ),
    'Add root entry to Directory table'
   );
mustDie (
    sub {$msi->addDirectory ();},
    'Win32::MSI::HighLevel::addDirectory requires a -Directory_Parent parameter',
    'Add empty dir fails'
);
mustDie (
    sub {
        $msi->addDirectory (
            -Directory_Parent => 'TARGETDIR',
            -Directory        => 'dir',
            -DefaultDir       => 'short~1|Short/One'
        );
    },
    'None of \?|><:/*" allowed: ',
    'Bad dir characters fail'
);
ok ($msi->writeTables (), 'Write updated tables to disk');
is (0, $msi->exportTable ('Directory', 'Tables'), 'Export Directory table');

checkTableEntry (
    "Directory\tDirectory_Parent\tDefaultDir",
    "s72\tS72\ts255",
    "Directory\tDirectory",
    "TARGETDIR\t\tSrcDir|SourceDir",
    "Root\tTARGETDIR\t.",
    "Dobbie\tTARGETDIR\ttarget~1|Target Dir:wibble~1|Wibble Plonk",
);

$msi = 0;    # Destroy object

unlink $filename;

print "Add a file to an empty database\n";
unlink $filename;
ok (
    $msi = Win32::MSI::HighLevel->new (
        -file => $filename,
        -mode => Win32::MSI::HighLevel::Common::kMSIDBOPEN_CREATE ()
    ),
    'Create a new .msi file in transacted mode'
   );

is (
    $msi->setProduct (
        -Language => 1033,
        -Name => 'Wibble',
        -Version => '1.0.0',
        -Manufacturer => 'Wibble Mfg. Co.'
        ),
    '{5C7C9ADE-0534-43B4-8C04-921F4A846CFA}',
    'Set product information'
   );

is (
    $msi->addFeature (-name => 'DefaultFeature', -Title => 'Default feature'),
    'DefaultFeature',
    'Add Default feature to Feature table'
   );

is (
    'TARGETDIR',
    $msi->addDirectory (
        -Directory        => 'TARGETDIR',
        -Directory_Parent => undef,
        -DefaultDir       => 'SrcDir|SourceDir'
    ),
    'Add root entry to Directory table'
   );

is (
    $msi->addFile (
        -sourceDir         => './Tables',
        -fileName          => 'Property.idt',
        -forceNewComponent => 'Property_idt',
        -featureId         => 'DefaultFeature'
    ),
    'Property.idt',
    'Add file entry to File table'
   );
ok ($msi->writeTables (), 'Write updated tables to disk');
is (0, $msi->exportTable ('Directory', 'Tables'), 'Export Directory table');

checkTableEntry (
"Directory\tDirectory_Parent\tDefaultDir",
"s72\tS72\ts255",
"Directory\tDirectory",
"Dir_.\tTARGETDIR\t.~1|.",
"Dir_Tables\tDir_.\tTables",
"TARGETDIR\t\tSrcDir|SourceDir",
);

is (0, $msi->exportTable ('File', 'Tables'), 'Export File table');

checkTableEntry (
    "File\tComponent_\tFileName\tFileSize\tVersion\tLanguage\tAttributes\tSequence",
    "s38\ts38\tl128\ti4\tS72\tS20\tI2\ti2",
    "File\tFile",
    "Property.idt\tProperty_idt\tProperty.idt\t58\t\t1033\t\t1",
);

$msi = 0;    # Destroy object

unlink $filename;
exit;


sub mustDie {
    my ($test, $errMsg, $name) = @_;

    eval {$test->();};

    my $isRightFail = defined ($@) && $@ =~ /\Q$errMsg\E/;

    print defined $@ ? "Error: $@\n" : "Unexpected success. Expected: $errMsg\n"
        if !$isRightFail;
    ok ($isRightFail, $name);
}


sub checkTableEntry {
    my ($columnNamesStr, $columnSpecsStr, $nameAndKeys, @testLines) = @_;
    my @colNames = split "\t", $columnNamesStr;
    my @colSpecs = split "\t", $columnSpecsStr;
    my ($tableName, @keyNames) = split "\t", $nameAndKeys;
    my $tablePath = File::Spec->rel2abs ("Tables\\$tableName.idt");
    my @keys;

    for my $colIndex (0 .. $#colNames) {
        my $colName = $colNames[$colIndex];

        push @keys, [$colName, $colIndex] if grep {$colName eq $_} @keyNames;
    }

    ok (
        (my $result = open (my $inFile, '<', $tablePath)),
        "Open $tableName table file for validation"
       );
    if (!$result) {
        print "Open $tablePath failed: $!\n";
        return;
    }

    matchTableLine ("column names for $tableName", scalar <$inFile>, @colNames);
    matchTableLine ("column specs for $tableName", scalar <$inFile>, @colSpecs);
    matchTableLine (
        "name and keys for $tableName",
        scalar <$inFile>,
        $tableName, @keyNames
    );

    my %tableEntries;

    while (my $line = <$inFile>) {
        addTableEntry ($line, \%tableEntries, @keys);
    }

    for my $testLine (@testLines) {
        my @colValues = split "\t", $testLine;
        my $keyStr = join " ", @colValues[map {$_->[1]} @keys];

        ok (exists $tableEntries{$keyStr}, "Check table row ($keyStr) exists");
        is ($testLine, $tableEntries{$keyStr}, "Check table line matches");
    }

    ok (close ($inFile), "Close $tableName table file\n");
}


sub matchTableLine {
    my ($comment, $line, @parts) = @_;
    my $refLine = join "\t", @parts;

    chomp $line;
    is ($line, $refLine, "Match $comment table");
}


sub addTableEntry {
    my ($line, $entries, @keys) = @_;

    chomp $line;
    my @colValues = split "\t", $line;
    my $keyStr = join " ", @colValues[map {$_->[1]} @keys];

    ok (!exists $entries->{$keyStr}, "Check table rows are unique");
    $entries->{$keyStr} = $line;
}