package Win32::MSI::HighLevel; use strict; use warnings; require 5.007003; # for Digest::MD5 BEGIN { use Exporter (); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @ISA = qw(Exporter); @EXPORT = qw(); @EXPORT_OK = qw(); %EXPORT_TAGS = (); } $Win32::MSI::HighLevel::VERSION = '1.0008'; use Carp; use Cwd; use File::Spec; use Win32; use Win32::API; use Win32::MSI::HighLevel::Common qw( kMSIDBOPEN_READONLY kMSIDBOPEN_TRANSACT kMSIDBOPEN_DIRECT kMSIDBOPEN_CREATE ); use Win32::MSI::HighLevel::Handle; use Win32::MSI::HighLevel::View; use Win32::MSI::HighLevel::Record; use Win32::MSI::HighLevel::ErrorTable; use base qw(Win32::MSI::HighLevel::Handle Exporter); use constant kReportUpdates => 1; our @EXPORT_OK = qw( kMSIDBOPEN_READONLY kMSIDBOPEN_TRANSACT kMSIDBOPEN_DIRECT kMSIDBOPEN_CREATE k_MSICOLINFO_INDEX kMSITR_IGNORE_ADDEXISTINGROW kMSITR_IGNORE_DELMISSINGROW kMSITR_IGNORE_ADDEXISTINGTABLE kMSITR_IGNORE_DELMISSINGTABLE kMSITR_IGNORE_UPDATEMISSINGROW kMSITR_IGNORE_CHANGECODEPAGE kMSITR_VIEWTRANSFORM kMSITR_IGNORE_ALL msidbRegistryRootClassesRoot msidbRegistryRootCurrentUser msidbRegistryRootLocalMachine msidbRegistryRootUsers msidbLocatorTypeDirectory msidbLocatorTypeFileName msidbLocatorTypeRawValue msidbLocatorType64bit msidbUpgradeAttributesMigrateFeatures msidbUpgradeAttributesOnlyDetect msidbUpgradeAttributesIgnoreRemoveFailure msidbUpgradeAttributesVersionMinInclusive msidbUpgradeAttributesVersionMaxInclusive msidbUpgradeAttributesLanguagesExclusive msidbComponentAttributesLocalOnly msidbComponentAttributesSourceOnly msidbComponentAttributesOptional msidbComponentAttributesRegistryKeyPath msidbComponentAttributesSharedDllRefCount msidbComponentAttributesPermanent msidbComponentAttributesODBCDataSource msidbComponentAttributesTransitive msidbComponentAttributesNeverOverwrite msidbComponentAttributes64bit SW_SHOWNORMAL SW_SHOWMAXIMIZED SW_SHOWMINNOACTIVE kReportUpdates ); =head1 NAME Win32::MSI::HighLevel - Perl wrapper for Windows Installer API =head1 VERSION Version 1.0008 =head1 SYNOPSIS use Win32::MSI::HighLevel; my $filename = 'demo.msi'; unlink $filename; my $msi = HighLevel->new (-file => $filename, -mode => Win32::MSI::HighLevel::Common::kMSIDBOPEN_CREATE); $msi->addFeature ( -Feature => 'Complete', -Title => 'Full install', -Description => 'Install the whole ball of wax' ); $msi->createTable ( -table => 'Feature', -columnSpec => [ Feature => ['Key', 'Identifier'], Feature_Parent => 'Identifier', Title => 'Text(64)', Description => 'Text(255)', Display => 'Integer', Level => 'Integer', Directory_ => 'Directory', Attributes => 'Integer', ] ); $msi->writeTables (); $msi->commit (); $msi = 0; =head1 DESCRIPTION Win32::MSI::HighLevel allows the creation (and editing) of Microsoft's Windows Installer technology based installer files (.msi files). The initial impetus to create this module came from trying to find an automated build system friendly way of creating Windows installers. This has been very nicely achieved, especially as the core table information can be provided in text based table description files and thus managed with a revision control system. Windows Installer files are simply database files. Almost all the information required for an installer is managed in tables in the database. This module facilitates manipulating the information in the tables. =head2 Obtaining a database object C returns a new database object. C<$mode> may be one of: =over 4 =item $Win32::MSI::MSIDBOPEN_READONLY This doesn't really open the file read-only, but changes will not be written to disk. =item $Win32::MSI::MSIDBOPEN_TRANSACT Open in transactional mode so that changes are written only on commit. This is the default. =item $Win32::MSI::MSIDBOPEN_DIRECT Opens read/write without transactional behavior. =item $Win32::MSI::MSIDBOPEN_CREATE This creates a new database in transactional mode. =back =head2 HighLevel Methods Generally sample usage is provided for each method followed by a description of the method, then followed by any named parameters recognized by the method. Most methods require named parameters. Named parameters with an uppercase first letter map directly on to table columns. Named parameters with a lower case first letter generally use contextual information to simplify using the method. Table column names with a trailing _ are key columns for their table. =cut # Constants and other definitions use constant msidbRegistryRootClassesRoot => 0; use constant msidbRegistryRootCurrentUser => 1; use constant msidbRegistryRootLocalMachine => 2; use constant msidbRegistryRootUsers => 3; use constant msidbLocatorTypeDirectory => 0; use constant msidbLocatorTypeFileName => 1; use constant msidbLocatorTypeRawValue => 2; use constant msidbLocatorType64bit => 16; use constant msidbUpgradeAttributesMigrateFeatures => 1; use constant msidbUpgradeAttributesOnlyDetect => 2; use constant msidbUpgradeAttributesIgnoreRemoveFailure => 4; use constant msidbUpgradeAttributesVersionMinInclusive => 256; use constant msidbUpgradeAttributesVersionMaxInclusive => 512; use constant msidbUpgradeAttributesLanguagesExclusive => 1024; use constant msidbComponentAttributesLocalOnly => 0x0000; use constant msidbComponentAttributesSourceOnly => 0x0001; use constant msidbComponentAttributesOptional => 0x0002; use constant msidbComponentAttributesRegistryKeyPath => 0x0004; use constant msidbComponentAttributesSharedDllRefCount => 0x0008; use constant msidbComponentAttributesPermanent => 0x0010; use constant msidbComponentAttributesODBCDataSource => 0x0020; use constant msidbComponentAttributesTransitive => 0x0040; use constant msidbComponentAttributesNeverOverwrite => 0x0080; use constant msidbComponentAttributes64bit => 0x0100; use constant SW_SHOWNORMAL => 1; use constant SW_SHOWMAXIMIZED => 3; use constant SW_SHOWMINNOACTIVE => 7; my $MsiOpenDatabase = Win32::MSI::HighLevel::Common::_def(MsiOpenDatabase => "PPP"); my $MsiOpenDatabasePIP = Win32::MSI::HighLevel::Common::_def(MsiOpenDatabase => "PIP"); my $MsiDataBaseCommit = Win32::MSI::HighLevel::Common::_def(MsiDatabaseCommit => "I"); my $MsiDatabaseApplyTransform = Win32::MSI::HighLevel::Common::_def(MsiDatabaseApplyTransform => "IPI"); my $MsiGetLastErrorRecord = Win32::MSI::HighLevel::Common::_def(MsiGetLastErrorRecord => ""); my $MsiFormatRecord = Win32::MSI::HighLevel::Common::_def(MsiFormatRecord => "IIPP"); my $MsiRecordSetString = Win32::MSI::HighLevel::Common::_def(MsiRecordSetString => "IIP"); my $MsiRecordGetInteger = Win32::MSI::HighLevel::Common::_def(MsiRecordGetInteger => "II"); my $MsiDatabaseExport = Win32::MSI::HighLevel::Common::_def(MsiDatabaseExport => 'IPPP'); my $MsiDatabaseImport = Win32::MSI::HighLevel::Common::_def(MsiDatabaseImport => 'IPP'); my %systemFolders = ( AdminToolsFolder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:ADMINT~1|Admin Tools' }, AppDataFolder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Applic~1|Application Data' }, CommonAppDataFolder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:APPLIC~1|Application Data' }, CommonFiles64Folder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Common~1|Common Files', }, CommonFilesFolder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Common~1|Common Files' }, DesktopFolder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Desktop'}, FavoritesFolder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Favori~1|Favorites' }, FontsFolder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Fonts'}, LocalAppDataFolder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:APPLIC~1|Application Data' }, MyPicturesFolder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:MYPICT~1|My Pictures' }, PersonalFolder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Personal'}, ProgramFiles64Folder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Progra~1|Program Files' }, ProgramFilesFolder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Progra~1|Program Files' }, ProgramMenuFolder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Programs'}, SendToFolder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:SendTo'}, StartMenuFolder => { -Directory_Parent => 'TARGETDIR', -DefaultDir => '.:StartM~1|Start Menu' }, StartupFolder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Startup'}, System16Folder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:System'}, System64Folder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => ''}, SystemFolder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:System32'}, TempFolder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Temp'}, TemplateFolder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:ShellNew'}, WindowsFolder => {-Directory_Parent => 'TARGETDIR', -DefaultDir => '.:Windows'}, WindowsVolume => {-Directory_Parent => '', -DefaultDir => ''}, ); =head3 new Create a new C instance given a file and open mode. my $msi = HighLevel->new (-file => $file, -mode => Win32::MSI::HighLevel::Common::kMSIDBOPEN_DIRECT); =over 4 =item I<-file>: required the .msi file to open/create =item I<-mode>: optional parameter - the open/create mode. Defaults to C Must be one of: =over 4 =item Win32::MSI::HighLevel::Common::kMSIDBOPEN_READONLY open for read only assess only =item Win32::MSI::HighLevel::Common::kMSIDBOPEN_TRANSACT open existing file for transacted access =item Win32::MSI::HighLevel::Common::kMSIDBOPEN_DIRECT open existing file for direct (non-transacted) access =item Win32::MSI::HighLevel::Common::kMSIDBOPEN_CREATE create a new file for transacted access (see L below) =item Win32::MSI::HighLevel::Common::kMSIDBOPEN_CREATEDIRECT create a new file for direct (non-transacted) access =back =item I<-sourceRoot>: optional Provide the (absolute) source directory that corresponds to the TARGETDIR directory on the target system. Directories on the target system have the same relative path from TARGETDIR as directories on the source system have to the source folder. C<-sourceRoot> defaults to the cwd. =item I<-targetRoot>: optional Provide the default (absolute) target directory for the install. Note that the actual location can be set at install time by the user. =item I<-workRoot>: optional Provide the path to a scratch location that can be used to create intermediate files and folders during the installer build process. =back =cut sub new { my ($type, %params) = @_; my $class = ref $type || $type; my $hdl = Win32::MSI::HighLevel::Handle->null(); Win32::MSI::HighLevel::Common::require(\%params, qw(-file)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-file -mode -noisy -workRoot -sourceRoot -targetRoot)); $params{-mode} ||= Win32::MSI::HighLevel::Common::kMSIDBOPEN_TRANSACT; $params{-file} = File::Spec->canonpath(File::Spec->rel2abs($params{-file})); $params{-workRoot} = $params{-sourceRoot} unless exists $params{-workRoot}; if ($params{-mode} =~ /^\d+$/) { $params{result} = $MsiOpenDatabasePIP->Call($params{-file}, $params{-mode}, $hdl); } else { $params{result} = $MsiOpenDatabase->Call($params{-file}, $params{-mode}, $hdl); } croak "Failed to open database $params{-file} in $class constructor\n" . _errorMsg() . "\nCould it be open already?" if $params{result}; $params{nextSeqNum} = 1; $params{usedSeqNum} = {}; $params{highestSeqNum} = $params{nextSeqNum}; $params{knownTables} = { AppSearch => \&_addAppSearchRow, Binary => \&_addBinaryRow, Component => \&_addComponentRow, Condition => \&_addConditionRow, Control => \&_addControlRow, ControlCondition => \&_addControlConditionRow, ControlEvent => \&_addControlEventRow, CreateFolder => \&_addCreateFolderRow, CustomAction => \&_addCustomActionRow, Dialog => \&_addDialogRow, Directory => \&_addDirectoryRow, Feature => \&_addFeatureRow, FeatureComponents => \&_addFeatureComponentsRow, File => \&_addFileRow, Icon => \&_addIconRow, InstallExecuteSequence => \&_addInstallExecuteSequenceRow, InstallUISequence => \&_addInstallUISequenceRow, Media => \&_addMediaRow, Property => \&_addPropertyRow, Registry => \&_addRegistryRow, RegLocator => \&_addRegLocatorRow, Shortcut => \&_addShortcutRow, Upgrade => \&_addUpgradeRow, }; $params{-noisy} ||= 0; $params{extraSep} = '-'; return $class->SUPER::new($hdl, %params); } sub DESTROY { my $self = shift; $self->commit() if $self->{handle}; $self->SUPER::DESTROY(); } sub _errorMsg { my ($host) = @_; my $dbHdl = 0; if (!ref $host) { $dbHdl = $host if defined $host and $host =~ /^\d+$/; } elsif ($host->isa('Win32::MSI::HighLevel::Record')) { $dbHdl = $host->{view}{highLevel}{handle}; } elsif ($host->isa('Win32::MSI::HighLevel::View')) { $dbHdl = $host->{highLevel}{handle}; } elsif ($host->isa('Win32::MSI::HighLevel')) { $dbHdl = $host->{handle}; } my $errRec = Win32::MSI::HighLevel::Record->fromHandle( $MsiGetLastErrorRecord->Call()); return '' unless $errRec; my $errCode = $MsiRecordGetInteger->Call($errRec->{handle}, 1); my $msg = ''; my $length = pack("l", 0); $MsiFormatRecord->Call(0, $errRec->{handle}, $msg, $length); $length = unpack("l", $length); unless ($length++) { $errCode = 0; return ''; } my $size = $length * 2; # length to UTF-16 siez $msg = "\0" x $size; return '' if $MsiFormatRecord->Call(0, $errRec->{handle}, $msg, $length); # Now UTF-8 encoded, trim to $length $msg = substr $msg, 0, $length; $msg =~ s/\0/\n/g; my %params = map {chomp; s/\s+$//; defined $_ ? $_ : ''} $msg =~ /(\d+):\s+(.*?)(?=\d+:|$)/g; return "see Microsoft Windows SDK documentation for 'Windows Installer Error Messages'. Params are: $msg" unless exists $params{1} and exists $Win32::MSI::HighLevel::ErrorTable::ErrMsgs{$params{1}}; my $str = $Win32::MSI::HighLevel::ErrorTable::ErrMsgs{$params{1}}; while ($str =~ /(?autovivifyTables (qw(Components Dialog Feature Properties)); Ensure that a list of tables exist. Create any tables in the list that do not exist already. This should be called after L has been called if you are not dealing with a new .msi file. =cut sub autovivifyTables { my ($self, @tables) = @_; for my $table (@tables) { next if exists $self->{tables}{$table} or _readonlyTable($table); $self->createTable(-table => $table); } } =head3 close Close the database. Generally L is not required to be called explicitly as the database should close cleanly when the C object is destroyed. $msi->close (); =cut sub close { my $self = shift; $self->DESTROY(); } =head3 commit L is used to update the database in transacted mode. Although the .msi database API provides a commit which B be called in transacted mode, there doesn't seem to be anything like an explicit rollback! An implicit rollback happens when the database is closed without a commit however. $msi->commit (); =cut sub commit { my ($self) = @_; $self->{result} = $MsiDataBaseCommit->Call($self->{handle}); croak "MsiDataBaseCommit failed with error code $self->{result}" if $self->{result}; return undef; } =head3 addAppSearch Add an entry to the AppSearch table. =over 4 =item I<-Property>: required Property that is set by the AppSearch action when it finds a match for the signature. =item I<-Signature_>: required An entry into the Signature table (for a file) or a directory name. =back =cut sub addAppSearch { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Property -Signature_)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Property -Signature_)); $self->_addAppSearchRow(\%params); } =head3 addBinaryFile Add a binary file to the installation. =over 4 =item I<-Name>: required Id to be used as the key entry in the binary file table. This entry must be unique. =item I<-file>: required Path to the file to be added on the source system. =back =cut sub addBinaryFile { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Name -file)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Name -file)); croak "File $params{-file} must exist during installer generation" unless -e $params{-file}; $params{-Data} = $params{-file}; $self->_addBinaryRow(\%params); } =head3 addCab Adds a cabinet file the the Cabs table and updates the media table to match. This routine is primarily used by createCabs and should not generally be required by users. =over 4 =item I<-name>: required =item I<-file>: required =item I<-disk>: required =item I<-lastSeq>: required =back =cut sub addCab { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-name -file -disk -lastSeq)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-name -file -disk -lastSeq)); $self->_addRow('Cabs', 'Name', {-Name => $params{-name}, -Data => $params{-file}}, ); $self->addMedia( -Cabinet => "#Cabs.$params{-name}", -DiskId => $params{-disk}, -LastSequence => $params{-lastSeq} ); } =head3 addComponent L adds a component associated with a specific Directory table entry and a group of files. my $newId = $msi->addComponent (-Directory_ => 'wibble', -features => ['Complete']); =over 4 =item I<-Attributes>: optional Component attribute flags ored together. Default value is 0 (no flags set). =item I<-Condition>: optional A condition that is used at install time to determine if the component should be installed. =item I<-Directory_>: required Identifier for the directory entry associated with the component. =item I<-features>: required Array of Feature table Feature identifiers that the component is referenced by. This parameter is required to generate appropriate entries in the FeatureComponents table. =item I<-File>: optional Optional file name for the key file associated with the component. If the directory is to be used in the CreateFolder table then the file name should be omitted and the directory name will be used as the key for the component. =item I<-guidSeed>: optional Provide an UpgradeCode guid so that a component installer can provide an upgraded component for an product installed using a different installer. The UpgradeCode guid must be the UprgadeCode guid used by the main product installer. I<-guidSeed> would normally be used with I<-requestedId>. =item I<-KeyPath>: optional Primary key into either the File, ODBCDataSource or Registry table. This is only required for generating a component that installs registry entries and doesn't install any files or directories. Do not use -File and -KeyPath together. =item I<-requestedId>: optional Desired id for component. If there exists a component with the same Id already then the suggested Id will be used as a base to generate a new Id. =back =cut sub addComponent { my ($self, %params) = @_; my %cParams; Win32::MSI::HighLevel::Common::require(\%params, qw(-Directory_ -features)); Win32::MSI::HighLevel::Common::allow( \%params, qw(-Attributes -Condition -Directory_ -features -File -KeyPath -requestedId -guidSeed ) ); my $compName; croak "setProduct must be called before a component is added" unless exists $self->{prodNamespace} || $self->_genProductCode(); croak "Only one of -File and -KeyPath may be used" if exists $params{-File} && exists $params{-KeyPath}; if (exists $params{-requestedId}) { $compName = $self->_getUniqueID($params{-requestedId}, "Component", 72); } elsif (exists $params{-File}) { $compName = $self->_getUniqueID($params{-File}, "Component", 72); } elsif (exists $systemFolders{$params{-Directory_}}) { croak "The system folder $params{-Directory_} may not be used as a Component!"; } else { $compName = $self->_getUniqueID($params{-Directory_}, "Component", 72); } return $self->{tables}{Component}{lc $compName}{-Component} if exists $self->{tables}{Component}{lc $compName}; my $guidSeed = exists $params{-guidSeed} ? $params{-guidSeed} : $self->getProperty('UpgradeCode'); $cParams{-Component} = $compName; $cParams{-ComponentId} = Win32::MSI::HighLevel::Common::genGUID("$guidSeed:$compName"); $cParams{-Directory_} = $params{-Directory_}; $cParams{-Attributes} = $params{-Attributes}; $cParams{-Attributes} ||= 0; $cParams{-Condition} = $params{-Condition}; $cParams{-KeyPath} = $params{-KeyPath} if exists $params{-KeyPath}; $cParams{-KeyPath} ||= exists $params{-File} && $params{-File}; $cParams{state} = Win32::MSI::HighLevel::Record::kNew; $self->_addComponentRow(\%cParams); $self->addFeatureComponents( -Component_ => $compName, -features => $params{-features} ); $self->{_flags}{addedCreateFolder} = undef; if (!defined $cParams{-KeyPath} or !length $cParams{-KeyPath}) { _genLu(\%cParams, 'CreateFolder'); if (!exists $self->{tables}{CreateFolder}{$cParams{-lu}}) { # Need to add a CreateFolder table entry my %cfParams = ( -Directory_ => $params{-Directory_}, -Component_ => $compName, ); $self->{_flags}{addedCreateFolder} = $self->_addCreateFolderRow(\%cfParams); } } return $cParams{-Component}; } =head3 addControlCondition L adds an entry to the control condition table. $msi->addControlCondition ( -Dialog_ => 'LicenseAgreementDlg', -Control_ => 'Install', -Action => Disable, -Condition => 'IAgree <> "Yes"' ); =over 4 =item I<-Dialog_>: required Id of the dialog containing the control. =item I<-Control_>: required Id of the control affected by the entry. =item I<-Action>: required Action to be taken if the condition is met. =item I<-Condition>: required Condition to be met for the action to be performed. =back =cut sub addControlCondition { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Dialog_ -Control_ -Action -Condition)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Dialog_ -Control_ -Action -Condition)); return $self->_addControlConditionRow(\%params); } =head3 addCreateFolder L adds an entry to the create folder table for the given folder. Component and directory table entries will be generated as required. my $entry = $msi->addCreateFolder (-folderPath => $dirPath); =over 4 =item I<-folderPath>: required Path name of the folder to create on the target system. =item I<-features>: required I<-features> provides an array reference for the list of feature ids for features that install the component that creates the folder. =back =cut sub addCreateFolder { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-folderPath -features)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-folderPath -features)); $self->{_flags}{addedCreateFolder} = undef; my %cfParams; $cfParams{-Directory_} = $self->getTargetDirID($params{-folderPath}); $cfParams{-Component_} = $self->getComponentIdForDirId( -Directory => $cfParams{-Directory_}, -features => $params{-features} ); return $self->{_flags}{addedCreateFolder} if defined $self->{_flags}{addedCreateFolder}; _genLu(\%cfParams, 'CreateFolder'); my $luKey = lc $cfParams{-lu}; if (exists $self->{tables}{CreateFolder}{$luKey}) { return $self->{tables}{CreateFolder}{$luKey}; } return $self->_addCreateFolderRow(\%cfParams); } =head3 addCustomAction Add an entry to the custom action table. $msi->addCustomAction ( -Action => 'InstallDriver', -Type => 3074, -Source => 'DriverInstaller', -Target => "[CommonFilesFolder]\\$Manufacturer\\driver.inf", ); This provides fairly raw access to the CustomAction table and is only part of the work required to set up a custom action. See the CustomAction Table section in the documentation referenced in the L section for further information. =over 4 =item I<-Action>: required Id for the custom action. =item I<-Type>: required A number comprised of various bit flags ored together. =item I<-Source>: optional A property name or external key into another table. This depends on the Type. =item I<-Target>: optional Additional information depending on the Type. =back =cut sub addCustomAction { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Action -Type)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Action -Type -Source -Target)); return $self->_addCustomActionRow(\%params); } =head3 addCustomActionJScriptFragment Add an inline JScript entry to the custom action table. $msi->addCustomActionJScriptFragment ( -Action => 'GetName', -script => '["TheName"] = ["Path"].match (/".*\\(.*)/)[1]' ); This adds a JScript custom action row. =over 4 =item I<-Action>: required Id for the custom action. =item I<-script>: required The JScript to execute. ["..."] is expanded to Session.Property ("...") The expanded string must be 255 characters or fewer. It may be multiple statements and may contain multiple lines. Line breaks will be removed however. =back =cut sub addCustomActionJScriptFragment { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Action -script)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Action -script)); $params{-script} =~ s/\[("\w+")\]/Session.Property ($1)/g; $params{-script} =~ s/[\n\r]\s*//g; croak "JScript must be 255 characters or fewer!" unless length($params{-script}) < 256; $params{-Target} = $params{-script}; $params{-Type} = 37; return $self->_addCustomActionRow(\%params); } =head3 addCustomActionJScriptFile Add JScript entry to the custom action table. $msi->addCustomActionJScriptFile ( -Action => 'GetRegString', -call => '["AppRelVers"] = CmpVersion ("foo.exe", "1.0.3");' -file => 'vercheck.js', ); This adds a JScript custom action row. =over 4 =item I<-Action>: required Id for the custom action. =item I<-call>: optional A fragment (255 characters or fewer) of JScript to be executed after the script has been loaded. Watch out for \ characters in file paths. You will need \\\\ to get a single \ in a quoted string by the time Perl has changed \\\\ to \\ then JScript changes \\ to \. -item I<-file>: required Name of the file containing the script to be processed. =back =cut sub addCustomActionJScriptFile { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Action -file)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Action -call -file)); (my $cleanFile = $params{-file}) =~ s/\W//g; my $key; $self->_haveUniqueId($cleanFile, 'CustomAction', 'Script', $key); $self->addBinaryFile(-Name => $key, -file => $params{-file}) unless exists $self->{tables}{Binary}{$key}; if (exists $params{-call}) { $params{-call} =~ s/\[("\w+")\]/Session.Property ($1)/g; $params{-call} =~ s/[\n\r]\s*//g; croak "JScript must be 255 characters or fewer!" unless length($params{-call}) < 256; $params{-Target} = $params{-call}; } $params{-Type} = 5; $params{-Source} = $key; return $self->_addCustomActionRow(\%params); } =head3 addCustomActionVBScriptFragment Add an inline VBScript entry to the custom action table. $msi->addCustomActionVBScriptFragment ( -Action => 'GetName', -script => '["TheName"] = ["Path"].match (/".*\\(.*)/)[1]' ); This adds a VBScript custom action row. =over 4 =item I<-Action>: required Id for the custom action. =item I<-script>: required The VBScript to execute. ["..."] is expanded to Session.Property ("...") The expanded string must be 255 characters or fewer. It may be multiple statements and may contain multiple lines. Line breaks will be removed however. =back =cut sub addCustomActionVBScriptFragment { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Action -script)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Action -script)); $params{-script} =~ s/\[("\w+")\]/Session.Property ($1)/g; $params{-script} =~ s/[\n\r]\s*//g; croak "VBScript must be 255 characters or fewer!" unless length($params{-script}) < 256; $params{-Target} = $params{-script}; $params{-Type} = 38; return $self->_addCustomActionRow(\%params); } =head3 addCustomActionVBScriptFile Add VBScript entry to the custom action table. $msi->addCustomActionVBScriptFile ( -Action => 'GetRegString', -call => '["AppRelVers"] = CmpVersion ("foo.exe", "1.0.3");' -file => 'vercheck.vbs', ); This adds a VBScript custom action row. =over 4 =item I<-Action>: required Id for the custom action. =item I<-call>: optional A fragment (255 characters or fewer) of VBScript to be executed after the script has been loaded. Watch out for \ characters in file paths. You will need \\\\ to get a single \ in a quoted string by the time Perl has changed \\\\ to \\ then VBScript changes \\ to \. -item I<-file>: required Name of the file containing the script to be processed. =back =cut sub addCustomActionVBScriptFile { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Action -file)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Action -call -file)); (my $cleanFile = $params{-file}) =~ s/\W//g; my $key; $self->_haveUniqueId($cleanFile, 'CustomAction', 'Script', $key); $self->addBinaryFile(-Name => $key, -file => $params{-file}) unless exists $self->{tables}{Binary}{$key}; if (exists $params{-call}) { $params{-call} =~ s/\[("\w+")\]/Session.Property ($1)/g; $params{-call} =~ s/[\n\r]\s*//g; croak "VBScript must be 255 characters or fewer!" unless length($params{-call}) < 256; $params{-Target} = $params{-call}; } $params{-Type} = 6; $params{-Source} = $key; return $self->_addCustomActionRow(\%params); } =head3 addDirectory L adds a directory with a specified parent directory to the directory table. my $entry = $msi->addDirectory (-Directory => $dir, -DefaultDir => $def, -Diretory_Parent => $parent); =over 4 =item I<-Directory>: optional Identifier for the directory entry to create. This identifier may be the name of a property set to the full path of the target directory. =item I<-Directory_Parent>: required This must be a Directory table -Directory column entry or undef. If -Diretory_Parent is undef or has the same value as -Directory the added entry is for a root directory and the root directory name is specified by -DefaultDir. There must only be one root directory in the Directory table. Except in the case of a root directory entry, the value given for -Diretory_Parent must already exist as a -Directory entry in the Directory table. =item I<-DefaultDir>: optional -DefaultDir provides directory names for the source and target directories for this table entry. -target and -source may be used instead of -DefaultDir. Different target and source directory names may be provided separated by a colon: [targetname]:[sourcename] Directory names may be given as [shortName]|[longName] pairs. [longName] may not include any of: \ ? | > < : / * " [shortName] additionally may not include spaces or any of: + , ; = [ ] A . may be used in place of [targetname] to indicate that the parent directory should be used rather than specifying a subdirectory. If none of -DefaultDir, -target and -source are provided, -DefaultDir is set to '.' (use parent directory). =item I<-target>: optional The [targetname] part of -DefaultDir. =item I<-source>: optional =back =cut sub addDirectory { my ($self, %params) = @_; my $table = $self->{tables}{Directory} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-Directory_Parent)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-DefaultDir -Directory -Directory_Parent -target -source)); croak "Root directory already supplied (only one allowed): $table->{_root}" if defined $table->{_root} and (!defined $params{-Directory_Parent} || $params{-Directory_Parent} eq $params{-Directory}); my $defaultDir; if (exists $params{-DefaultDir}) { $defaultDir = $params{-DefaultDir}; } else { $params{-target} ||= ''; $params{-source} ||= ''; $params{-target} = '.' if $params{-source} eq $params{-target}; $params{-source} = '' unless length $params{-source}; $defaultDir = $params{-target}; $defaultDir .= ":$params{-source}" if length $params{-source}; } $params{-DefaultDir} = $defaultDir; # Root is required. writeTables checks that a valid root was provided $table->{_root} ||= undef; unless (defined $params{-Directory_Parent} && $params{-Directory_Parent} ne $params{-Directory}) { $params{-Directory} ||= 'TARGETDIR'; $params{-DefaultDir} ||= 'SOURCEDIR'; $params{-Directory_Parent} ||= ''; $table->{_root} = $params{-Directory}; } croak "A -Directory parameter is required when not providing the root directory ($defaultDir)" unless exists $params{-Directory} and defined $params{-Directory}; croak "Parent directory ($params{-Directory_Parent}) must be provided before children" if length $params{-Directory_Parent} and !exists $table->{lc $params{-Directory_Parent}} and !exists $systemFolders{$params{-Directory_Parent}}; return $self->_addDirectoryRow(\%params); } =head3 addDirPath L is not fully implemented should not be used. Use multiple calls to L instead. =cut # my $root = $msi->addDirPath (-source => $rootDir, -target => $installDir); # #L adds a directory tree rooted at C<-source> on the generating #machine. C<-source> must exist in the source machine when L is #called. # #L calls L for each directory entry in #the tree rooted at C<-source>. # #A hash is returned where the keys are the identifiers generated to identify #each directory entry added to the table and the values are a hash containing two #entries C<< (-dirName => directory name, -subdirs => {subdirectory hash}) >>. The #keys must be used when required to identify the directories from other tables or #in subsequent calls to c that add further directories from the same #context. # #Note that should not be used to create directories outside the install context. #Instead use L. # #The following parameters are recognized by L: # #=over 4 # #=item I<-source> # #Root of the directory tree to be added from the generating machine. If neither a #C<-rootParent> nor a C<-target> parameter is provided then C<-source> is assumed to be #the root directory for the install and C is provided as the parent #directory (see Directory Table in the SDK documentation). # #=item I<-rootParent> # #Identifier for the parent directory for C<-source>. This must be provided if #C<-source> is not the root of the install tree. Typically # #=item I<-target> # #Default install directory on the target system. This value may be altered by the #user at install time if it is for the root directory. # #Using a C<.> as the target for a non-root directory means that the target is the #parent directory rather than a subdirectory. # #If a long file name (or a file name containing characters not allowed in a short #filename) is given, a short file name will be generated. # #=back # #=cut sub addDirPath { my ($self, %params) = @_; my $dirs = $self->{tables}{Directory} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-target -source)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-target -source)); croak "Implementation incomplete."; } =head3 addDrLocator L adds a DrLocator table row. It is used with L and L to provide the information needed by the AppSearch action. =cut sub addDrLocator { my ($self, %params) = @_; my $dirs = $self->{tables}{Directory} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-Signature_)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Signature_ -Parent -Path -Depth)); return $self->_addDrLocator(\%params); } =head3 addMsiDriverPackages Adds a device driver package to the installer. $msi->addMsiDriverPackages (-Component => 'InstallDriver', -Flags => (2 | 4)); =over 4 =item I<-Component>: required Id for the custom action. =item I<-Flags>: optional A number comprised of various bit flags ored together. See the I topic in the I documentation for the use of this parameter. the default value is 0. =item I<-Sequence>: optional Determines driver installation order. Packages are installed in increasing order of sequence number. Packages with the same sequence value are installed in arbitrary order. =back =cut sub addMsiDriverPackages { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Component)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Component -Flags -Sequence)); croak "A valid component Id is required for addMsiDriverPackages" unless defined $params{-Component} and exists $self->{tables}{Component}{lc $params{-Component}}; $params{-Flags} ||= 0; $params{-Sequence} ||= 0; return $self->_addMsiDriverPackagesRow(\%params); } =head3 addFeature Add an installation feature. Parent features must be added before child features are added. Multiple root features are allowed and provide different installation configurations. my $root = $msi->addFeature (-name => 'Complete', -Title => 'Full install'); The following parameters are recognized by L =over 4 =item I<-Attributes>: optional C<-Attributes> is set to msidbFeatureAttributesFavorLocal by default. For a discussion of the C<-Attributes> parameter see the Feature Table documentation (see L below). =item I<-Description>: optional A textual description of the feature shown in the text control of the selection dialog. =item I<-Directory_>: optional Directory associated with the feature that may be configured by the user at install time. The directory must already have been added with L, L or L. =item I<-Display>: optional Determines the display state and order of this feature in the feature list. If C<-Display> is not provided it will be set so that the new feature is shown after any previous features and is shown collapsed. If C<-Display> is set to 0 it is not shown. If C<-Display> is odd is is shown expanded. If C<-Display> is even it is shown collapsed. Display values must be unique. =item I<-Feature_Parent>: optional Identifier for the parent feature. If this parameter is missing a root feature is generated. =item I<-Level>: optional, default = 3 Initial installation level for the feature. See the Feature Table documentation for a discussion of installation level (see L below). For a single feature install a value of 3 (the default) is often used. 0 may be used for a feature that is not to be installed at all. =item I<-name>: required The name of the feature to add. =item I<-Title>: optional The name of the feature to add. =back =cut sub addFeature { my ($self, %params) = @_; my $table = $self->{tables}{Feature} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-name)); Win32::MSI::HighLevel::Common::allow( \%params, qw( -Attributes -Description -Directory_ -Display -Feature_Parent -Level -name -Title ) ); $params{-Feature} ||= $self->_getUniqueID($params{-name}, 'Feature', 38); $params{-Level} ||= 3; if (!exists $params{-Display}) { my $next = exists $self->{usedDisplay} ? undef : 1; $next ||= (sort @{$self->{usedDisplay}})[-1] + 1; $params{-Display} = $next; } croak "Feature level must be in the range 0 - 32767" unless $params{-Level} >= 0 and $params{-Level} <= 32767; croak "Display order value must be unique or 0. $params{-Display} has been used." if $params{-Display} and grep {$_ == $params{-Display}} @{$self->{usedDisplay}}; croak "Feature must be unique - $params{-Feature} has already been used" if exists $table->{lc $params{-Feature}}; push @{$self->{usedDisplay}}, $params{-Display}; # Root is required. writeTables checks that a valid root was provided $table->{_root} ||= undef; unless (defined $params{-Feature_Parent}) { $table->{_root} = $params{-Feature}; } my $hashKey = lc $params{-Feature}; $params{-Attributes} ||= 0; $params{-Display} ||= 1 unless defined $params{-Feature_Parent}; return $self->_addFeatureRow(\%params); } =head3 addFeatureComponents Add FeatureComponent rows for a given Component and each of a list of Features. $msi->addFeatureComponents (-Component_ => 'Wibble', -features => ['Complete']); I returns the number of rows actually added to the FeatureComponents table. Duplicate rows will not be added, but are not an error. =over 4 =item I<-Component_>: required The Component table key id. =item I<-features>: required A reference to an array of Feature table key ids. =back =cut sub addFeatureComponents { my ($self, %params) = @_; my $added; Win32::MSI::HighLevel::Common::require(\%params, qw(-Component_ -features)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Component_ -features)); for my $featureId (@{$params{-features}}) { my %fcParams; $fcParams{-Feature_} = $featureId; $fcParams{-Component_} = $params{-Component_}; _genLu(\%fcParams, qw(Component_ Feature_)); next if exists $self->{tables}{FeatureComponents}{lc $fcParams{-lu}}; ++$added, $self->_addFeatureComponentsRow(\%fcParams) unless exists $self->{lookup}{FeatureComponents} {lc "$params{-Component_}/$featureId"}; } return $added; } =head3 addFile L is used to add a file to be installed. Adding a file associated with a feature (or features) updates the File and DiskId tables and may update the Component, FeatureComponent and DuplicateFile tables. my $file = $msi->addFile (-source => $filepath, -featureId => 'Complete'); Default values are determined for C<-Sequence> and C<-Version> from the source file which must be available when L is called. =over 4 =item I<-cabFile>: optional Provide the name of a cab file the current file should be added to. By default the file is added to an internally generated cab file. If the file is to not to be compressed and stored internally in a cab file C<-cabFile> should be set to C. See also L. =item I<-condition>: optional If provided the I<-condition> is applied to the component the file is installed by. A new component will be created if the condition does not match the condition on an existing component that would otherwise have been used. =item I<-featureId>: required Id of the Feature that the file is to be installed for. =item I<-fileId>: optional Id to be used as the File column (and thus key) entry for the file being added. By default I<-fileName> is used for this value. I<-fileId> must be unique. I<-skipDupAdd> will be ignored if I<-fileId> is provided. =item I<-fileName>: required Name of the file to be installed. Note that a long file name should be given: L generates the required short file name. =item I<-forceNewComponent>: optional If present this parameter forces a new component to be generated. If the value is scalar it is used as a suggested component name otherwise an array ref containing a list of parameters to be passed to addComponent is expected. If a parameter list is provided it may be empty and required parameters for addComponent will be generated. =item I<-isKey>: optional File is a key file for a component. Required to be set true if there is to be a shortcut to the file. If the file is a PE format file (.exe, .dll, ...) C<-isKey> is implied. =item I<-Language>: optional Specify the language ID or IDs for the file. If more than one ID is appropriate use a comma separated list. If this parameter is omitted the value '1033' (US English) is used. To specify that no ID should be used (for font files for example) use an empty string. =item I<-requestedId>: optional A suggested component name. If the name has been used and the file being inserted is not suitable for the existing component a new component name based on the requested name will be used. =item I<-Sequence>: optional Determines the order in which files are installed. By default files are installed in the order that they are added. Setting C<-Sequence> for a file sets the install position for that file and any files added subsequently. If setting the sequence number for a file causes a collision with any file already added the previously added files are moved later in the install sequence (their sequence number is increased). Note that any subsequently added files may also cause previously added files to be installed later. In other words, setting C<-Sequence> for a file allows a group of files to be inserted at a particular place in the install order. Use: -Sequence => undef to reset to adding files at the end of the install order. =item I<-sourceDir>: required Path to the directory containing the file to be installed. =item I<-skipDupAdd>: optional Skip adding the file if an entry already exists for it. This option is ignored if I<-fileId> is provided. =item I<-targetDir>: optional Path to the directory the file is to be installed to on the target system. If C<-targetDir> is not provided the target directory will be set to be in the same relative location as the source directory is to the source root directory. C<-sourceDir> must be in the directory tree below the source root directory if C<-targetDir> is not provided. =item I<-Version>: optional C<-Version> should only be set to specify a companion file (see "Companion Files" in the SDK documentation). For a versioned file the version number is obtained from the file's version resource. =back =cut sub addFile { my ($self, %params) = @_; my $table = $self->{tables}{File} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-featureId -sourceDir -fileName)); Win32::MSI::HighLevel::Common::allow( \%params, qw( -condition -featureId -fileId -fileName -forceNewComponent -isKey -Language -requestedId -Sequence -skipDupAdd -sourceDir -targetDir -Version ) ); croak "Feature $params{-featureId} must be provided before a file ($params{-fileName}) is added for it" unless exists $self->{tables}{Feature}{lc $params{-featureId}}; $self->createTable(-table => 'File') unless exists $self->{tables}{File}; $params{-sourceDir} =~ s|\\\\$||; $params{-path} = "$params{-sourceDir}\\$params{-fileName}"; $params{-path} = File::Spec->canonpath($params{-path}); Win32::MSI::HighLevel::Common::croak( "Required file ($params{-path}) does not exist") unless -f $params{-path}; $params{-sourceDirRel} = File::Spec->abs2rel($params{-sourceDir}, $self->{-sourceRoot}); $params{-Version} = Win32::GetFileVersion($params{-path}); if ($params{-skipDupAdd} and !exists $params{-fileId}) { my $luKey = lc "$params{-sourceDirRel}\\$params{-fileName}"; return $self->{lookup}{filePath}{$luKey} if exists $self->{lookup}{filePath}{$luKey}; } open my $testFile, '<:raw', $params{-path} or croak("Unable to open file $params{-path}: $!"); my $header = ''; read $testFile, $header, 256, 0; # No test - doesn't matter if read fails my $isPE = $header =~ /^MZ/; if ($isPE) { my $peOffset = substr($header, 0x3c, 4); $peOffset = unpack('V', $peOffset); seek $testFile, $peOffset, 0; my $ok = read $testFile, $header, 2; $isPE = $ok and $header =~ /^PE/; } CORE::close $testFile; $params{-targetDir} = $params{-sourceDir} if !defined $params{-targetDir}; $params{-directory_} = $self->getTargetDirID($params{-targetDir}) if not exists $params{-directory_}; if (exists $params{-fileId}) { $params{-File} = $params{-fileId}; } else { $params{-File} = $self->_getUniqueID("$params{-fileName}", 'File', 72, $params{-sourceDirRel}); } my $compName; my $components = $self->{tables}{Component} ||= {}; if (!$isPE and !exists $params{-forceNewComponent}) { # Look for suitable existing component my @comps = values %{$self->{tables}{Component}}; for my $comp (@comps) { next if !ref $comp; next if $comp->{-Directory_} ne $params{-directory_}; next if exists $params{-condition} and $comp->{-Condition} ne $params{-condition}; next if exists $params{-requestedId} and $comp->{-Component} ne $params{-requestedId}; # Ignore -isKey for component matching so all files that could be # included in a component are included in a single component keyed # by a specified file. $compName = $comp->{-Component}; last; } } $params{-FileSize} = -s $params{-path}; if (!defined $compName) { # Need to create a new Component table entry my %cParams; my @wanted = qw(-File ); if (exists $params{-forceNewComponent}) { if (ref $params{-forceNewComponent}) { %cParams = @{$params{-forceNewComponent}}; } else { $cParams{-requestedId} = $params{-forceNewComponent}; } } elsif (exists $params{-requestedId}) { $cParams{-requestedId} = $params{-requestedId}; } $cParams{-Condition} = $params{-condition} if exists $params{-condition}; $cParams{$_} = $params{$_} for grep {exists $params{$_}} @wanted; $compName = $self->addComponent( %cParams, -Directory_ => $params{-directory_}, -features => [$params{-featureId}], ); } my $compRef = $self->{tables}{Component}{lc $compName}; if ($params{-isKey} && $compRef->{-KeyPath} ne $params{-File}) { my $compTable = $self->{tables}{Component}; $compRef->{-KeyPath} = $params{-File}; } $params{-Component_} = $compName; $params{-FileName} = $self->_longAndShort($params{-fileName}); $params{-Sequence} = ''; $params{-Language} = '1033' unless exists $params{-Language}; return $self->_addFileRow(\%params); } =head3 addIconFile Add an icon file to the installation. my $iconId = $msi->addIconFile ('path/to/unique_file_name.ico'); Note that an internal ID is generated from the file name (excluding the path to the file). The file name must thus only contain alphanumeric characters, periods and the underscore character. Two icon files that differ only in their path, but have the same name will cause grief (only one of the files will be used). This condition is B checked for! The generated internal Id is returned and may be used for the C<-Icon_> parameter required in other tables. The file must exist at the time that I is called. I may be called multiple times with the same file =cut sub addIconFile { my ($self, $file) = @_; croak "File $file must exist during installer generation" unless -e $file; croak "Illegal characters in icon file name: $file. Alphanumeric, '.' and '_' only allowed." unless (my $name) = $file =~ /([\w.]*)$/; $name = lc $name; return $name if exists $self->{tables}{Icon}{$name}; my %params = (-Data => $file, -Name => $name); $self->_addIconRow(\%params); return $name; } =head3 addInstallExecuteSequence Add an entry to the custom action table. $msi->addInstallExecuteSequence ( -Action => 'InstallDriver', -Condition => 'NOT MYDRIVERINSTALLED AND NOT Installed', -Sequence => 3959, ); This provides fairly raw access to the CustomAction table and is only part of the work required to set up a custom action. See the CustomAction Table section in the documentation referenced in the L section for further information. =over 4 =item I<-Action>: required Id for the action. This must be either a built-in action or a custom action. A matching entry must exist in the CustomAction table if this is a custom action. =item I<-Condition>: optional A conditional expression that must evaluate true at run time for the step to be executed. =item I<-Sequence>: required Sequence position for execution of this action. =item I<-secureProperties>: optional A public property or array ref containing a list of public properties used in the I<-Condition> expression that need to be passed securely into the execute context. The property names will be added to the SecureCustomProperties property during L. =back =cut sub addInstallExecuteSequence { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Action -Sequence)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Action -Condition -Sequence -secureProperties)); return $self->_addInstallExecuteSequenceRow(\%params); } =head3 addInstallUISequence Add an entry to the custom action table. $msi->addInstallUISequence ( -Action => 'SetDefTargetDir', -Condition => '', -Sequence => 1100, ); =over 4 =item I<-Action>: required Id for the action. This must be either a built-in action or a custom action. A matching entry must exist in the CustomAction table if this is a custom action. =item I<-Condition>: optional A conditional expression that must evaluate true at run time for the step to be executed. =item I<-Sequence>: required Sequence position for execution of this action. =back =cut sub addInstallUISequence { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Action -Sequence)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Action -Condition -Sequence)); return $self->_addInstallUISequenceRow(\%params); } =head3 addLaunchCondition Add an entry to the custom action table. $msi->addLaunchCondition ( -Condition => 'NOT Version9X', -Description => 'Windows versions prior to XP are not supported.', ); This provides fairly raw access to the CustomAction table and is only part of the work required to set up a custom action. See the CustomAction Table section in the documentation referenced in the L section for further information. =over 4 =item I<-Condition>: required A conditional expression that must evaluate true at run time for the install to proceed. =item I<-Description>: required Error text shown if the launch condition evaluates false. =item I<-secureProperties>: optional A public property or array ref containing a list of public properties used in the I<-Condition> expression that need to be passed securely into the execute context. The property names will be added to the SecureCustomProperties property during L. =back =cut sub addLaunchCondition { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Condition -Description)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Condition -Description -secureProperties)); if (exists $params{-secureProperties}) { my $param = $params{-secureProperties}; $param = join ';', ref $param ? @$param : $param; } return $self->_addLaunchConditionRow(\%params); } =head3 addMedia (see also L) Add a cabinet file to the Media table. $msi->addMedia (-Cabinet => '#cab1', -DiskId => 1, -LastSequence => 20); If all the files required by the install are to be part of the .msi file then addMedia can be ignored - L does all the work required. =over 4 =item I<-Cabinet>: optional Name of the cabinet file. A # as the first character in the name indicates that the cabinet file will be stored in a stream in the .msi file. In this case the name is case sensitive. If the first character in the name is not a # then the name must be given as a short file name (8.3 format) and the cabinet is stored in a separate file located at the root of the source tree specified by the Directory Table. =item I<-DiskId>: required A number (1 or greater) that determines the sort order of the media table. =item I<-LastSequence>: required Sequence number of the last file in this media. =item I<-DiskPrompt>: optional Name (on the label for physical media) used to identify the physical media associated with this media entry. =item I<-Source>: optional Source to be used for patching. =item I<-VolumeLabel>: optional Volume label to be used to identify physical media. =back =cut sub addMedia { my ($self, %params) = @_; my $table = $self->{tables}{Media} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-DiskId -LastSequence)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Cabinet -DiskId -DiskPrompt -LastSequence -Source -VolumeLabel)); $params{-Cabinet} = '' if !defined $params{-Cabinet}; return $self->_addMediaRow(\%params); } =head3 addProperty (see also L) Add a property value to the Property table. A new property id is generated based on the supplied id if a property of the same name exists already. $msi->addProperty (-Property => 'Manufacturer', -Value => 'Wibble Corp.'); The actual property id used is returned. =over 4 =item I<-Property>: required Suggested property name =item I<-Value>: required Property value =back =cut sub addProperty { my ($self, %params) = @_; my $table = $self->{tables}{Property} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-Property -Value)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Property -Value -context)); $params{-Property} = $self->_getUniqueID($params{-Property}, 'Property', 72, $params{-context}); return $self->_addPropertyRow(\%params); } =head3 addRegistry Add a registry entry. $msi->addRegistry ( -root => HighLevel::msidbRegistryRootClassesRoot, -Component_ => 'Application', -Key => '.app', -Name => undef, -Value => 'MyApp' ); =over 4 =item I<-Component_>: optional Id of the component controlling installation of the registry value. This parameter is required unless I<-genRegKey> is used. =item I<-genRegKey>: optional Generates the registry table key and returns it, but doesn't generate the table entry. This option is required to solve a chicken and egg problem with components that use a Registry table key for their KeyPath. =item I<-Key>: required Key path which may include properties but must not start or end with a backslash (\). =item I<-Name>: optional =item I<-Root>: required =item I<-Value>: required Registry value to add. =back =cut sub addRegistry { my ($self, %params) = @_; my $table = $self->{tables}{Registry} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-Key -Root -Value)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Component_ -genRegKey -Key -Name -Root -Value)); Carp::croak "-Component_ is required unless -genRegKey is used" if !(exists $params{-Component_} || exists $params{-genRegKey}); my $regId = $self->_getUniqueID("$params{-Root}/$params{-Key}/$params{-Name}", 'Registry'); return $regId if exists $params{-genRegKey}; $params{-Name} ||= ''; $params{-Registry} = $regId; return $self->_addRegistryRow(\%params); } =head3 addRegLocator Add a RegLocator table entry. $msi->addRegLocator ( -Signature_ => 'MyDriver', -Root => HighLevel::msidbRegistryRootLocalMachine, -Key => 'SYSTEM\CurrentControlSet\Control\Class\{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}', -Name => 'Class', -Type => HighLevel::msidbLocatorTypeRawValue, ); =over 4 =item I<-64Bit>: optional Set to search the 64-bit portion of the registry. The 32-bit portion of the registry will not be searched if -64Bit is set. =item I<-directory>: optional A key into the Directory table to be set from the registry. One of I<-directory>, I<-file> and I<-property> is required. =item I<-file>: optional A key into the File table to be set from the registry. One of I<-directory>, I<-file> and I<-property> is required. =item I<-Key>: required Key path. =item I<-Name>: optional Registry value name. If omitted the default value is used. =item I<-property>: optional A key into the AppSearch table for the row that contains the property to be set to the registry value. One of I<-directory>, I and I<-property> is required. =item I<-Root>: required One of: =over 4 =item msidbRegistryRootClassesRoot: HKEY_CLASSES_ROOT =item msidbRegistryRootCurrentUser: HKEY_CURRENT_USER =item msidbRegistryRootLocalMachine: HKEY_LOCAL_MACHINE =item msidbRegistryRootUsers: HKEY_USERS =back =back =cut sub addRegLocator { my ($self, %params) = @_; my $table = $self->{tables}{Registry} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-Key -Root)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-64Bit -directory -file -Key -Name -property -Root)); $params{-Name} ||= ''; my $type = 0; my $signature; if (exists $params{-directory}) { $signature = $params{-directory}; $type = msidbLocatorTypeDirectory; } elsif (exists $params{-file}) { $signature = $params{-file}; $type = msidbLocatorTypeFileName; } elsif (exists $params{-property}) { $signature = $params{-property}; $type = msidbLocatorTypeRawValue; } $type |= msidbLocatorType64bit if exists $params{'-64Bit'} && $params{'-64Bit'}; $params{-Signature_} = $signature; $params{-Type} = $type; croak "One of -directory, -file or -property required" unless defined $signature; return $self->_addRegLocatorRow(\%params); } =head3 addSelfReg Add a SelfReg table entry. $msi->addSelfReg ( -File_ => $fileTableKey, -Cost => HighLevel::msidbRegistryRootLocalMachine ); =over 4 =item I<-Cost>: required The cost in bytes due to self registering this .dll. =item I<-File_>: required The key in the File table for the .dll to self register. =back =cut sub addSelfReg { my ($self, %params) = @_; my $table = $self->{tables}{Registry} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-File_ -Cost)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-File_ -Cost)); return $self->_addSelfRegRow(\%params); } #=head3 addRemoveFile # #Add a RemoveFile table entry to remove files or an empty #folder. # #=over 4 # #=item I<-FileKey>: optional # #Unique id identifying this table entry # #=item I<-directory>: required # #Path to the directory to remove or remove files from. # #=item I<-directory>: required # #Path to the directory to remove or remove files from. # #=item I<-directory>: required # #Path to the directory to remove or remove files from. # #=item I<-InstallMode>: required # #One of: # #=over 4 # #=item msidbRemoveFileInstallModeOnInstall: remove on install # #=item msidbRemoveFileInstallModeOnRemove: remove on uninstall # #=item msidbRemoveFileInstallModeOnBoth: always remove # #=back # #=back # #=cut # #sub addRemoveFile { # my ($self, %params) = @_; # my $table = $self->{tables}{RemoveFile} ||= {}; # # Win32::MSI::HighLevel::Common::require (\%params, qw(-Key -Root)); # Win32::MSI::HighLevel::Common::allow (\%params, # qw(-64Bit -directory -file -Key -Name -property -Root)); # $params{-Name} ||= ''; # # my $type = 0; # my $signature; # # if (exists $params{-directory}) { # $signature = $params{-directory}; # $type = msidbLocatorTypeDirectory; # # } elsif (exists $params{-file}) { # $signature = $params{-file}; # $type = msidbLocatorTypeFileName; # # } elsif (exists $params{-property}) { # $signature = $params{-property}; # $type = msidbLocatorTypeRawValue; # } # # $type |= msidbLocatorType64bit # if exists $params{'-64Bit'} && $params{'-64Bit'}; # $params{-Signature_} = $signature; # $params{-Type} = $type; # # croak "One of -directory, -file or -property required" # unless defined $signature; # # return $self->_addRegLocatorRow (\%params); #} =head3 addShortcut The following parameters are recognized by L: =over 4 =item I<-Arguments>: optional The command line arguments for the shortcut. =item I<-Component_>: optional (see also C<-target> and C<-Target>) The id for the Component table entry which determines whether the the shortcut will be deleted or created. The shortcut is created if the component has been installed and is deleted otherwise. If C<-Component_> is not provided the component associated with C<-target> or C<-Target> will be used. =item I<-Description> The localizable description of the shortcut. =item I<-Directory_>: optional (see also C<-location>) The id for the Directory table entry which specifies where the shortcut file will be created. The Directory entry need not exist until L is called and is not checked. One only of C<-location> and C<-Directory_> must be provided. =item I<-featureId> The feature the shortcut is installed by. =item I<-Hotkey> The hotkey for the shortcut. The low-order byte contains the virtual-key code for the key, and the high-order byte contains modifier flags. =item I<-folderTarget>: optional (see also C<-target> and C<-Target>) The folder pointed to by the shortcut. Note that this folder must already have been provided using L, L or L. One only of C<-folderTarget>, C<-target> and C<-Target> must be provided. =item I<-location>: optional (see also C<-Directory_>) The directory where the shortcut file will be created. Note that the directory must already have been added with L, L or L. The directory provided will be searched for in the Directory table to find the directory id to be used for C<-Directory_>. One only of C<-location> and C<-Directory_> must be provided. =item I<-name>: required Name to be shown for the shortcut. Note that the name need not be unique. =item I<-Shortcut>: optional Suggested internal id to be used for the shortcut. Note that if there is another shortcut with the same id already a new id will be generated by appending a number to the given id. The id actually used is returned. If C<-Shortcut> is omitted a suitable id will be generated from the C<-Name> value. =item I<-ShowCmd>: optional The mode used to show the window used by the shortcut when run. May be one of the following constants: =over =item SW_SHOWNORMAL - Show normalised =item SW_SHOWMAXIMIZED - Show maximised =item SW_SHOWMINNOACTIVE - Show iconised =back If C<-ShowCmd> is omitted default Windows behavior is used (SW_SHOWNORMAL). =item I<-Target>: optional (see also C<-folderTarget> and C<-target>) The Feature id or a Property id that specifies the target of the shortcut. If a Feature id is provided the target is the key file of the Component_ table entry associated with the Feature. If a Property id is provided the target is the file or directory specified as the value of the property. One only of C<-folderTarget>, C<-target> and C<-Target> must be provided. =item I<-target>: optional (see also C<-folderTarget> and C<-Target>) The file pointed to by the shortcut. Note that this file must already have been provided using L or L. One only of C<-folderTarget>, C<-target> and C<-Target> must be provided. =item I<-WkDir>: optional (see also C<-wkdir>) The Directory id that specifies the working directory for the shortcut. One only of C<-wkdir> and C<-WkDir> may be provided. =item I<-wkdir>: optional (see also C<-WkDir>) The working directory for the shortcut. A directory table will be created if required. One only of C<-wkdir> and C<-WkDir> may be provided. =back =cut sub addShortcut { my ($self, %params) = @_; my $table = $self->{tables}{Shortcut} ||= {}; my $featureId = $params{-featureId}; Win32::MSI::HighLevel::Common::require(\%params, qw(-name -featureId)); Win32::MSI::HighLevel::Common::allow( \%params, qw( -Arguments -Component_ -Description -Directory_ -featureId -folderTarget -location -Hotkey -Icon_ -name -Shortcut -ShowCmd -Target -target -WkDir -wkdir ) ); croak "Only one of -WkDir and -wkDir allowed\n" if exists $params{-WkDir} and exists $params{-wkDir}; my $count; ++$count for grep {exists $params{$_}} qw(-folderTarget -Target -target); croak "Only one of -folderTarget, -Target and -target allowed\n" if $count > 1; croak "One of -folderTarget, -Target and -target required\n" unless $count; croak "Only one of -Directory_ and -location allowed\n" if exists $params{-Directory_} and exists $params{-location}; croak "One of -Directory_ and -location required\n" unless exists $params{-Directory_} or exists $params{-location}; $params{-Directory_} = $self->getTargetDirID($params{-location}) if not exists $params{-Directory_}; $params{-location} ||= $params{-Directory_}; if (exists $params{-folderTarget}) { my $target = $self->getTargetDirID($params{-folderTarget}); $params{-Target} = "[$target]"; } elsif (exists $params{-target}) { my $target = $params{-target}; my ($path, $file) = $target =~ m!(.*)[\\/](.*)!; my $dirId = $self->getTargetDirID($path); $params{-Target} = defined $dirId ? "[$dirId]\\$file" : $target; } my $lookup = "$params{-Target}/$params{-Directory_}"; $params{-Shortcut} = $self->_getUniqueID($params{-name}, 'Shortcut', undef, $lookup); # Note that a Directory table entry is required for the working directory # entry, not a property entry. The Shortcut table documentation is wrong! $params{-WkDir} = $self->getTargetDirID($params{-wkdir}) if exists $params{-wkdir}; $params{-Component_} ||= $self->addComponent( -Directory_ => $params{-Directory_}, -features => [$featureId] ); $params{-Name} = $self->_longAndShort($params{-name}); return $self->_addShortcutRow(\%params); } =head3 addSignature Add an entry to the Signature table used by the AppSearch action to match previously installed applications. The following parameters are recognized by L: =over 4 =item I<-FileName>: required The name of the file to search for. =item I<-Languages>: optional Specify the language ID or IDs for the file. If more than one ID is specified use a comma separated list. Multiple entries require a file supporting all specified languages for a match. =item I<-MaxDate>: optional The maximum creation date of the file. If this parameter is specified, then the file must have a creation date that is at most equal to MaxDate. This must be a non-negative number. The format of this field is two packed 16-bit values of type WORD. The high order WORD value specifies the date in MS-DOS date format. The low order WORD value specifies the time in MS-DOS time format. A value of 0 for the time value represents midnight. The formula for calculating the value is: (($Year - 1980) * 512 + $Month * 32 + $Day) * 65536 + $Hours * 2048 + $Minutes * 32 + $Seconds / 2 =item I<-MinDate>: optional The minimum modification date and time of the file. If this field is specified, then the file under inspection must have a modification date and time that is at least equal to MinDate. See I<-MaxSize> above. =item I<-MinSize>: optional The minimum size of the file. If this parameter is specified, then the file under inspection must have a size that is at least equal to MinSize. This must be a non-negative number. =item I<-MaxVersion>: optional The maximum version of the file. If this parameter is specified, then the file must have a version that is at most equal to MaxVersion. =item I<-MinVersion>: optional The minimum version of the file, with a language comparison. If this field is specified, then the file must have a version that is at least equal to MinVersion. If the file has an equal version to the MinVersion field value but the language specified in the Languages column differs, the file does not satisfy the signature filter criteria. Note The language specified in the Languages parameter is used in the comparison and there is no way to ignore language. If you want a file to meet the MinVersion field requirement regardless of language, you must enter a value in the MinVersion field that is one less than the actual value. For example, if the minimum version for the filter is 2.0.2600.1183, use 2.0.2600.1182 to find the file without matching the language information. =item I<-Signature>: required This required parameter must be a unique id that is used as an external key by various tables involved in searching for applications and related files, directories and registry entries. =back =cut sub addSignature { my ($self, %params) = @_; my $table = $self->{tables}{Signature} ||= {}; my $featureId = $params{-featureId}; Win32::MSI::HighLevel::Common::require(\%params, qw(-Signature -FileName)); Win32::MSI::HighLevel::Common::allow( \%params, qw( -Signature -FileName -MinVersion -MaxVersion -MinSize -MaxSize -MinDate -MaxDate -Languages ) ); return $self->_addSignatureRow(\%params); } =head3 addStorage Add a binary file to the installation as a storage. =over 4 =item I<-Name>: required Id to be used as the key entry in the storages table. This entry must be unique. =item I<-file>: required Path to the file to be added on the source system. =back =cut sub addStorage { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Name -file)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Name -file)); croak "File $params{-file} must exist during installer generation" unless -e $params{-file}; $params{-Data} = $params{-file}; $self->_addStorageRow(\%params); } =head3 addUpgrade Add an upgrade table entry. $msi->addUpgrade ( -UpgradeCode => $UpgradeGUID, -VersionMin => 1.0, -VersionMax => 2.0 ); =over 4 =item I<-UpgradeCode>: optional UpgradeCode GUID associated with the product detected by the Upgrade table entry being added. If this parameter is omitted the UpgradeCode Property table entry will be used. Calling C sets the UpgradeCode Property table entry. Version numbers (if provided) must be in the form C. y and z will be set to 0 if they are omitted. x, y, and z must be numeric. A fourth value is not allowed. =item I<-VersionMin>: optional Minimum product version number that this table entry will detect. If both C<-VersionMin> and C<-VersionMax> are omitted C<-VersionMin> will be set to 0 to find all product versions. =item I<-VersionMax>: optional Maximum product version number that this table entry will detect. If both C<-VersionMin> and C<-VersionMax> are omitted C<-VersionMax> will be set to null to find all product versions. =item I<-Language>: optional Must be one of Microsoft's language codes. For example US English is 0x0409. Language matching will be ignored if C<-Language> is omitted. =item I<-Attributes>: optional The following attributes may be ored together: msidbUpgradeAttributesMigrateFeatures Copy selected features msidbUpgradeAttributesOnlyDetect Detect only - don't uninstall msidbUpgradeAttributesIgnoreRemoveFailure Ignore uninstall failure msidbUpgradeAttributesVersionMinInclusive Include min version msidbUpgradeAttributesVersionMaxInclusive Include max version msidbUpgradeAttributesLanguagesExclusive Include all langs except listed See the MSDN documentation for further information about these attributes. =item I<-Remove>: optional List of features to be removed during the install. A single feature name or an array reference containing feature names is expected. =item I<-ActionProperty>: required Public property name (must be upper case) of the property that will be set to the list of product codes for installed products matching this upgrade entry. This property name will be added to the SecureCustomProperties property during L. =back =cut sub addUpgrade { my ($self, %params) = @_; my $table = $self->{tables}{Registry} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-ActionProperty)); Win32::MSI::HighLevel::Common::allow( \%params, qw( -UpgradeCode -VersionMin -VersionMax -Language -Attributes -Remove -ActionProperty ) ); if (!exists $params{-UpgradeCode}) { my $ucProp = $self->getProperty('UpgradeCode'); croak "-UpgradeCode parameter or UpgradeCode property required for addUpgrade" unless defined $ucProp; $params{-UpgradeCode} = $ucProp; } $params{-Attributes} ||= 0; my $residuleFlags = $params{-Attributes} & ~0x707; croak "Bad -Attributes value used for addUpgrade: $residuleFlags" if $residuleFlags; $params{-Language} ||= ''; croak "One of -VersionMin and -VersionMax required for addUpgrade" unless exists $params{-VersionMin} or exists $params{-VersionMax}; for my $key (qw()) { next unless exists $params{$key}; next if $params{$key} =~ /^\d+(\.\d+(\.\d+)?)?$/; croak "Version number must be of the form x[.y[.z]].\n" . " $params{$key} is not valid for $key"; } return $self->_addUpgradeRow(\%params); } =head3 createCabs Creates the cab files as required from the files that have been added with L or L. $msi->createCabs (); Note that L must be called after all files have been added and before L is called. Note too that makecab.exe must be available on the system being used. With versions of Windows from Windows 2000 on makecab.exe seems to be provided with the system so this should not generally be an issue. If L generates a 'makecabs.exe not found' error copy makecabs.exe into the working directory or add the path to makecabs.exe to the PATH environment variable. L updates the C table as appropriate. Note that L generates a C file that may be used as a manifest of the files added to the install (ignore lines starting with .). =cut sub createCabs { my $self = shift; unless (exists $self->{tables}{Cabs}) { $self->createTable( -table => 'Cabs', -columnSpec => [ Name => [qw(Identifier(32) Key Required)], Data => [qw(Binary Required)] ] ); } my $fileTable = $self->{tables}{File}; my @files = sort {$a->[0] cmp $b->[0]} map {[$fileTable->{$_}{-Component_}, $_]} grep {ref $fileTable->{$_}} keys %$fileTable; if (!@files) { # Add an empty media table entry $self->addMedia(-DiskId => 1, -LastSequence => 1); return; } my $lastComponent = $files[0][0]; my $sequence = 1; my $cabDFF = "$self->{-workRoot}\\cab.dff"; open CABDFF, '>', $cabDFF; print CABDFF <{$key}; my $absPath = File::Spec->rel2abs($file->{-path}); if ($component ne $lastComponent) { print CABDFF ".New Folder\n"; $lastComponent = $component; } $fileTable->{$key}{-Sequence} = $sequence++; print CABDFF "\"$absPath\" $file->{-File}\n"; } print CABDFF <{-workRoot}; mkdir "$self->{-workRoot}\\disk1" unless -d "$self->{-workRoot}\\disk1"; `makecab /F $cabDFF /L "$self->{-workRoot}" /V1`; chdir $workDir; $self->addCab( -name => 'cab1.cab', -file => "$self->{-workRoot}\\disk1\\cab1.cab", -disk => 1, -lastSeq => $sequence - 1 ); } =head3 createTable Creates a new database table. my $table = $msi->createTable (-table => 'Feature'); my $table = $msi->createTable ( -table => 'Properties', -columnSpec => [ Property => [qw(Key Identifier(72) Required)], Value => [qw(Text(0) Required)], ] ); C knows the column specification for the following commonly used tables: C. Any other tables must be created by providing a suitable I<-columnSpec> parameter. If there are tables that you use regularly that are not included in the list above contact the module maintainer with the column specification and suggest that it be added. =over 4 =item I<-columnSpec>: optional Specification for the table's columns. This is required for tables that Win32::MSI::HighLevel doesn't handle by default. Note that custom tables may be added to the installer file. The column specification comprises an array of column name => type pairs. Most of the types mentioned in the MSDN documentation are recognized, including: =over 4 =item AnyPath: =item Cabinet: CHAR(255) =item DefaultDir: CHAR(255) =item Directory: CHAR(72) =item Filename: CHAR(128) LOCALIZABLE =item Formatted: CHAR(255) =item Identifier: CHAR(38) =item Integer: INT =item Language: CHAR(20) =item Long: LONG =item Property: CHAR(32) =item Required: NOT NULL =item Shortcut: CHAR(255) =item Text: CHAR(255) LOCALIZABLE =item UpperCase: CHAR(255) =item Version: CHAR(72) =back Where the default type includes a size (number in parenthesis) a different size may be supplied by including it in parenthesis following the type: Text(0) =item I<-table>: required Name of the table to create. =back =cut sub createTable { my ($self, %params) = @_; my %types = ( AnyPath => 'CHAR(255)', Binary => 'OBJECT', Cabinet => 'CHAR(255)', Condition => 'CHAR(255)', CustomSource => 'CHAR(255)', DefaultDir => 'CHAR(255)', Directory => 'CHAR(72)', DoubleInteger => 'LONG', Filename => 'CHAR(128) LOCALIZABLE', Formatted => 'CHAR(255)', GUID => 'CHAR(38)', Identifier => 'CHAR(38)', Integer => 'INT', KeyPath => 'CHAR(255)', Language => 'CHAR(20)', Long => 'LONG', Property => 'CHAR(32)', RegPath => 'CHAR(255)', Required => 'NOT NULL', Shortcut => 'CHAR(255)', Text => 'CHAR(255) LOCALIZABLE', UpperCase => 'CHAR(255)', Version => 'CHAR(72)', WildCardFilename => 'CHAR(128) LOCALIZABLE', ); my %columnSpecs = ( AppSearch => [ Property => [qw(Key Identifier(72) Required)], Signature_ => [qw(Key Identifier(72) Required)], ], Binary => [ Name => [qw(Identifier(32) Key Required)], Data => [qw(Binary Required)] ], Component => [ Component => [qw(Key Identifier(72) Required)], ComponentId => 'GUID', Directory_ => [qw(Directory Required)], Attributes => [qw(Integer Required)], Condition => [qw(Condition)], KeyPath => [qw(KeyPath(80))], ], ControlCondition => [ Dialog_ => [qw(Key Identifier(72) Required)], Control_ => [qw(Key Identifier(50) Required)], Action => [qw(Key Text(50) Required)], Condition => [qw(Key Condition Required)], ], CreateFolder => [ Directory_ => [qw(Key Identifier(72) Required)], Component_ => [qw(Key Identifier(72) Required)], ], CustomAction => [ Action => [qw(Key Identifier(72) Required)], Type => [qw(Integer Required)], Source => [qw(CustomSource)], Target => [qw(Formatted)], ], Directory => [ Directory => [qw(Key Identifier(72) Required)], Directory_Parent => ['Identifier(72)'], DefaultDir => [qw(DefaultDir Required)], ], DrLocator => [ Signature_ => [qw(Key Text Required)], Parent => [qw(Key Identifier(72))], Path => [qw(Key Text)], Depth => [qw(Integer)], ], Extension => [ Extension => [qw(Key Text Required)], Component_ => [qw(Key Identifier(72) Required)], ProgId_ => [qw(Text)], MIME_ => [qw(Text)], Feature_ => [qw(Identifier Required)], ], Feature => [ Feature => [qw(Key Identifier Required)], Feature_Parent => ['Identifier'], Title => ['Text(64)'], Description => ['Text(255)'], Display => ['Integer'], Level => [qw(Integer Required)], Directory_ => ['Directory'], Attributes => [qw(Integer Required)], ], FeatureComponents => [ Feature_ => [qw(Key Identifier Required)], Component_ => [qw(Key Identifier(72) Required)], ], File => [ File => [qw(Key Identifier Required)], Component_ => [qw(Identifier Required)], FileName => [qw(Filename Required)], FileSize => [qw(DoubleInteger Required)], Version => [qw(Version)], Language => [qw(Language)], Attributes => [qw(Integer)], Sequence => [qw(Integer Required)], ], Icon => [ Name => [qw(Identifier(32) Key Required)], Data => [qw(Binary Required)] ], InstallUISequence => [ Action => [qw(Identifier(72) Key Required)], Condition => [qw(Condition)], Sequence => [qw(Integer Required)], ], LaunchCondition => [ Condition => [qw(Key Condition Required)], Description => [qw(Formatted Required)], ], Media => [ DiskId => [qw(Key Integer Required)], LastSequence => [qw(Long Required)], DiskPrompt => [qw(Text(64))], Cabinet => [qw(Cabinet)], VolumeLabel => [qw(Text(32))], Source => [qw(Property)], ], MsiDriverPackages => [ Component => [qw(Key Text(255) Required)], Flags => [qw(Long Required)], Sequence => [qw(Long)], ], Property => [ Property => [qw(Key Identifier(72) Required)], Value => [qw(Text(0) Required)], ], ProgId => [ ProgId => [qw(Key Text Required)], ProgId_Parent => [qw(Text)], Class_ => [qw(GUID)], Description => [qw(Text)], Icon_ => [qw(Identifier)], IconIndex => [qw(Integer)], ], RegLocator => [ Signature_ => [qw(Key Identifier(72) Required)], Root => [qw(Integer Required)], Key => [qw(RegPath Required)], Name => [qw(Formatted)], Type => [qw(Integer)], ], RemoveFile => [ FileKey => [qw(Key Identifier Required)], Directory_ => [qw(Identifier Required)], FileName => [qw(WildCardFilename)], DirProperty => [qw(Identifier Required)], InstallMode => [qw(Identifier Required)], ], SelfReg => [ File_ => [qw(Key Identifier(72) Required)], Cost => [qw(Integer Required)] ], ServiceControl => [ ServiceControl => [qw(Key Identifier(72) Required)], Name => [qw(Formatted Required)], Event => [qw(Integer Required)], Arguments => [qw(Formatted)], Wait => [qw(Integer)], Component_ => [qw(Identifier(72) Required)], ], ServiceInstall => [ ServiceInstall => [qw(Key Identifier(72) Required)], Name => [qw(Formatted Required)], DisplayName => 'Formatted', ServiceType => [qw(DoubleInteger Required)], StartType => [qw(DoubleInteger Required)], ErrorControl => [qw(DoubleInteger Required)], LoadOrderGroup => 'Formatted', Dependencies => 'Formatted', StartName => 'Formatted', Password => 'Formatted', Arguments => 'Formatted', Component_ => [qw(Identifier(72) Required)], Description => 'Formatted', ], Shortcut => [ Shortcut => [qw(Key Identifier(72) Required)], Directory_ => [qw(Identifier(72) Required)], Name => [qw(Filename Required)], Component_ => [qw(Identifier(72) Required)], Target => [qw(Directory Required)], Arguments => 'Formatted', Description => 'Text', Hotkey => 'Integer', Icon_ => 'Identifier(72)', IconIndex => 'Integer', ShowCmd => 'Integer', WkDir => 'Identifier(72)', DisplayResourceDLL => 'Formatted', DisplayResourceId => 'Integer', DescriptionResourceDLL => 'Formatted', DescriptionResourceId => 'Integer', ], Signature => [ Signature => [qw(Key Identifier(72) Required)], FileName => [qw(Text Required)], MinVersion => [qw(Version)], MaxVersion => [qw(Version)], MinSize => [qw(DoubleInteger)], MaxSize => [qw(DoubleInteger)], MinDate => [qw(DoubleInteger)], MaxDate => [qw(DoubleInteger)], Languages => [qw(Text)], ], Upgrade => [ UpgradeCode => [qw(Key GUID Required)], VersionMin => [qw(Key Version)], VersionMax => [qw(Key Version)], Language => [qw(Key Text)], Attributes => [qw(Key Integer Required)], Remove => 'Formatted', ActionProperty => [qw(Identifier Required)], ], Verb => [ Extension_ => [qw(Key Text Required)], Verb => [qw(Key Text Required)], Sequence => [qw(Integer)], Command => [qw(Formatted)], Argument => [qw(Formatted)], ], ); if (exists $params{_keys}) { # Return the keys for the given table my $tableSpec = $columnSpecs{$params{_keys}}; croak "Internal error - no column specification for $params{_keys} table" unless defined $tableSpec; my %fields = @$tableSpec; my @keys = grep { grep {$_ eq 'Key'} @{$fields{$_}} } keys %fields; return @keys; } Win32::MSI::HighLevel::Common::require(\%params, qw(-table)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-table -columnSpec)); croak "$params{-table} is a temporary or read only table and can not be created." if _readonlyTable($params{-table}); croak "A known table type ($params{-table} given) or a -columnSpec parameter is required" unless exists $params{-columnSpec} or exists $columnSpecs{$params{-table}}; $params{-columnSpec} = $columnSpecs{$params{-table}} unless exists $params{-columnSpec}; my @columnSpecs; my @keys; while (@{$params{-columnSpec}}) { my ($column, $spec) = splice @{$params{-columnSpec}}, 0, 2; croak "No type specification provided for column $columnSpecs[-1]" unless defined $spec and 'ARRAY' eq ref($spec) || !ref($spec); push @columnSpecs, "`$column`"; my @specArray = 'ARRAY' eq ref $spec ? @$spec : $spec; for my $type (@specArray) { if ($type eq 'Key') { push @keys, $column; next; } my ($base, $size) = $type =~ /^(\w+) (?:\((\d+)+\))?/x; croak "Unknown column specification type ($type) for column $columnSpecs[-1]" unless exists $types{$base}; my $specText = $types{$base}; $specText .= "($size)" if defined $size and $specText !~ s/\(\d+\)/($size)/; $columnSpecs[-1] .= " $specText"; } $columnSpecs[-1] =~ s/^(\S+\s\S+)(.*)(\sNOT NULL)/$1$3$2/; $columnSpecs[-1] =~ s/^(\S+\s\S+(?:\sNOT NULL)?)(.*)(\sTEMPORARY)/$1$3$2/; $columnSpecs[-1] =~ s/^(\S+\s\S+(?:\sNOT NULL)?(?:\sTEMPORARY)?)(.*)(\sLOCALIZABLE)/$1$3$2/; next; } croak "No key column provided for table $params{-table}" unless @keys; my $columnSpec = join ', ', @columnSpecs; my $sql = "CREATE TABLE `$params{-table}` ($columnSpec"; $sql .= ' PRIMARY KEY ' . join(', ', map {"`$_`"} @keys) . ')'; my $table = Win32::MSI::HighLevel::View->new($self, query => $sql, %params); $self->{tables}{$params{-table}}{_created} = 1; $self->commit(); # Ensure table is created in database return $table && $params{-table}; } =head3 dropTable Removes a database table. my $table = $msi->dropTable ('Feature'); =cut sub dropTable { my ($self, $table) = @_; return Win32::MSI::HighLevel::View->new($self, query => "DROP TABLE `$table`"); } =head3 expandPath Expand a path including system folder properties to a path with the system folders resolved by examining Directory table entries. my $path = expandPath ($filePath); L returns a long path. =cut sub expandPath { my ($self, $path) = @_; return $path unless $path =~ s/^\[([^\]]+)\]//; my $dirId = lc $1; if (!exists $self->{tables}{Directory}{$dirId}) { return "$systemFolders{$1}$path" if exists $systemFolders{$1}; warn "No Directory ID matching $1 found while expanding [$1]$path\n"; return "$1$path"; } my $prefix = ''; while (defined $dirId and length $dirId) { last unless exists $self->{tables}{Directory}{$dirId}; my $dir = $self->{tables}{Directory}{$dirId}; my ($short, $long) = @{$self->_dirPair($dir->{-DefaultDir})}; $long .= '\\' if length $prefix; $prefix = "$long$prefix"; $dirId = $dir->{-Directory_Parent}; } return "$prefix$path"; } =head3 exportTable Saves a database table in a .csv file format. my $table = $msi->exportTable ('Directory', '.\Tables'); Important! You must L before calling L to ensure that the database version of the table matches the internal cached version. The sample code would export the Directory table as the file 'Directory.idt' to the sub-directory Tables in the current working directory. If the table includes streams a sub-directory to the directory containing the exported file will be created with the same base name as the table. A file for each stream will then be created in the sub-directory. The created files will have the extension '.idb'. Note that the table name _SummaryInformation may be used to write out the Summary Information Stream. Also note that the exported file format is ideal for management using a revision control system. See also L. =cut sub exportTable { my ($self, $table, $path) = @_; $path = File::Spec->rel2abs($path); mkdir $path unless -d $path; my $result = $MsiDatabaseExport->Call($self->{handle}, $table, $path, "$table.idt"); return $result; } =head3 getComponentIdFromFileId Return the component Id for the given file Id. my %entry = getComponentIdFromFileId ('Wibble.txt'); This call does not create a component or file entry. It returns null if there is not a matching file id. =cut sub getComponentIdFromFileId { my ($self, $fileId) = @_; return $self->{tables}{File}{lc $fileId}{-Component_} if exists $self->{tables}{File}{lc $fileId}; return undef; } =head3 getComponentIdForDirId Return the component Id for the component that has a null KeyPath and a Directory_ value matching the directory id passed in. my %entry = getComponentIdForDirId (-Directory => 'Wibble', -features => ['Complete']); A component is created if there is not an appropriate existing component. FeatureComponent table entries will be generated if a Component table entry is generated. =over 4 =item I<-Directory>: required Directory Id to find (or create) a matching component Id for. =item I<-features>: required The list of features that install the component associated with the directory. =back =cut sub getComponentIdForDirId { my ($self, %params) = @_; Win32::MSI::HighLevel::Common::require(\%params, qw(-Directory -features)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Directory -features)); croak "Directory table doesn't exist." unless exists $self->{tables}{Directory}; croak "$params{-Directory} is not a directory id" unless exists $self->{tables}{Directory}{lc $params{-Directory}}; if (exists $self->{tables}{Component}{lc $params{-Directory}}) { my $component = $self->{tables}{Component}{lc $params{-Directory}}; $component = $component->{-Component}; $self->addFeatureComponents( -Component_ => $component, -features => $params{-features} ); return $component; } return $self->addComponent( -Directory_ => $params{-Directory}, -features => $params{-features} ); } =head3 getId Return the table key id generated for a given id. For example: my $dirId = $msi->getId ('MyDir', 'Directory', 'my\\path'); will return the unique id generated for the MyDir directory entry in the Directory table with 'my\path' as the parent path. =cut sub getId { my ($self, $id, $context, $extra) = @_; $extra ||= ''; my $key = lc "$id$self->{extraSep}$extra"; $key =~ s/^[^|]*\|//; # Retain only long file name portion $_[4] = $key if exists $_[4]; # 'Return' key if (exists $self->{id_keyToId}{$context}{$key}) { return $self->{id_keyToId}{$context}{$key}; } else { return undef; } } =head3 getParentDirID dirId Returns the parent Directory table id given an existing directory id. my $dirId = $msi->getParentDirID ('WibbleApp'); If the dirId passed in does not exist an undef will be returned, otherwise a string (which may be empty for a root dir) will be returned. =cut sub getParentDirID { my ($self, $dirId) = @_; my $parentId; my $dirTable = $self->{tables}{Directory}; $self->_buildDirLookup(); return unless exists $dirTable->{$dirId}; return $dirTable->{$dirId}{-Directory_Parent}; } =head3 getProduct Return a string containing product and major version information. my $productString = $msi->getProduct (); =cut sub getProduct { my ($self) = @_; my $name = $self->getProperty('ProductName'); my $vers = $self->getProperty('ProductVersion'); my $manf = $self->getProperty('Manufacturer'); return "$manf: $name - $vers"; } =head3 getProductCode Return a GUID as a string containing product code for the installer. my $productGUID = $msi->getProductCode (); If a product code does not yet exist it will be generated as the MD5 sum of the ProductName, ProductLanguage, ProductVersion and Manufacturer property values. =cut sub getProductCode { my ($self) = @_; return $self->{productCode} if exists $self->{productCode}; return $self->_genProductCode(); } =head3 getProperty Return the Property value for the given property name. Returns undef of the property entry doesn't exist. my %entry = $msi->getProperty ($propName); =cut sub getProperty { my ($self, $key) = @_; my $rec = $self->getTableEntry('Property', {'-Property' => $key}); return undef if !defined $rec; return $rec->{-Value}; } =head3 getTableEntry Return a reference to the table column data for a given table entry. my $entry = $msi->getTableEntry ('File', {-File => 'wibble.exe'}); Returns undef if the table or key doesn't exist. If fields within the $entry hash ref are edited L must be called. A degree of caution is advised in using this member. Very little checking can be performed on the results of editing the hash returned. Generally errors will result in failures at L time. =cut sub getTableEntry { my ($self, $name, $keys) = @_; my $key = lc join '/', map {$keys->{$_}} sort keys %$keys; return undef unless exists $self->{tables}{$name}; return undef unless exists $self->{tables}{$name}{$key}; my $entry = {%{$self->{tables}{$name}{$key}}}; $entry->{'!key'} = $key; $entry->{'!name'} = $name; $entry->{'!lu'} = $entry->{-lu}; return $entry; } =head3 getTargetDirID targetpath [public [wantedId]] L returns a Directory table id given an install time target file path. Entries in the Directory table will be created as required to generate an appropriate id. my $dirId = $msi->getTargetDirID ('[ProgramFilesFolder]\Wibbler\WibbleApp'); An existing Directory table entry may be used as the first element of a directory path. If an existing Directory table entry is used it must be the first element of the directory path. Relative paths are with respect to the target install directory (TARGETDIR). Where existing Directory table entries match a given path prefix the existing entries are used to reduce proliferation of table entries. L generally takes a single unnamed parameter which is the install time (target) path to match. Note that the paths may use either \ or / delimiters. All path components are assumed to be long (not short "filename"). Short "filenames" will be generated as required. An optional (second) boolean parameter may be provided to indicate that the Directory is public. That is, that at install time the user may change the install location for the directory. If a true value is provided as the second parameter the directory Id is forced to upper case to make the entry a public directory entry. An optional third parameter may be provided to suggest an Id. If provided the boolean 'public' parameter must be provided also. The following system folder properties may be used directly as shown in the sample code above: =over 4 =item CommonAppDataFolder Full path to the file directory containing application data for all users =item CommonFilesFolder Full path to the Common Files folder for the current user =item StartMenuFolder Full path to the Start Menu folder =back =cut sub getTargetDirID { my ($self, $path, $public, $wantedId) = @_; my $id; my $dirTable = $self->{tables}{Directory}; $self->_buildDirLookup(); $path =~ s!\\!/!g; my @parts = split '/', $path; my $parent = 'TARGETDIR'; while (@parts) { my ($part) = (shift @parts) =~ /\[?([^\]]*)\]?$/; my $lcPart = lc $part; my @entrys; my $entry; @entrys = keys %{$self->{DirLookup}{$lcPart}} if defined $self->{DirLookup}{$lcPart}; for (@entrys) { next unless $self->{DirLookup}{$lcPart}{$_}{-Directory_Parent} eq $parent; $entry = $self->{DirLookup}{$lcPart}{$_}; last; } # See if it's a predefined directory if (!defined $entry and exists $systemFolders{$part}) { $entry = {%{$systemFolders{$part}}, -Directory => $part}; $self->addDirectory(%$entry) if !defined $self->{tables}{Directory}{$lcPart}; } if (!defined $entry) { # Create the Directory table entry and the lookup entry my $short = $self->_longToShort($part); my $defDir = $short; my $dirId = "Dir_$part"; # Avoid property id clashes # Dir id must be uc if it is public (eg, for a feature dir) $dirId = uc $dirId if !@parts and $public and uc($part) ne $part; $dirId = $wantedId if !@parts and defined $wantedId; $dirId = $self->_getUniqueID($dirId, "Directory", undef, $parent); if (!defined $dirId or !length $dirId) { croak "Failed to generate a directory id for $path"; } $defDir .= "|$part" unless lc $short eq $lcPart; $self->addDirectory( -DefaultDir => $defDir, -Directory => $dirId, -Directory_Parent => $parent, ); $entry = $dirTable->{lc $dirId}; $self->{DirLookup}{lc $dirId}{$entry->{-Directory}} = $entry; $self->{DirLookup}{$lcPart}{$entry->{-Directory}} = $entry; } $id = $parent = $entry->{-Directory}; } return $id; } =head3 haveDirId dirName Returns a reference to the Directory table entry for given directory Id if it exists or undef otherwise. my $dirEntry = $msi->haveDirId ('Wibble'); =cut sub haveDirId { my ($self, $dirName) = @_; return unless exists $self->{tables}{Directory}{lc $dirName}; return $self->{tables}{Directory}{lc $dirName}; } =head3 importTable Imports an exported database table in a .csv file format. my $table = $msi->importTable ('.\Tables', 'Directory'); $msi->writeTables (); $msi->populateTables (); Important! You should L and then L following calling L to ensure the cached table information matches the database version. The sample code would import the Directory table from the file 'Directory.idt' in the Tables sub-directory of current working directory. C will create an absolute path from the folder path passed in as the second parameter. undef will be returned on success and an error string will be returned on failure. Note that the table name _SummaryInformation may be used to import the Summary Information Stream. =cut sub importTable { my ($self, $table, $path) = @_; #define ERROR_FUNCTION_FAILED 1627L // Function failed during execution #define ERROR_BAD_PATHNAME 161L #define ERROR_INVALID_HANDLE_STATE 1609L #define ERROR_INVALID_PARAMETER 87L $path = File::Spec->rel2abs($path); my $result = $MsiDatabaseImport->Call($self->{handle}, $path, "$table.idt"); return undef unless $result; return _errorMsg(); } =head3 installService Install a Win32 service that runs its own process. $msi->installService(-serviceName => 'MyService', -Component_ => $component); At install time a previous instance of the service will be stopped and uninstalled. The new instance will then be installed and optionally started. =over =item I<-serviceName>: required Name used to identify the service. This must uniquely identify the service on the target system or unhappy things will happen. =item I<-Component_>: required The component that the service file is installed by. This is used by the installer to ensure the service is installed at the correct time. =item I<-name>: optional The name of the service to be installed. If a name is not provided -serviceName is used. =item I<-state>: optional One of 'auto' or 'demand' with 'auto' used by default. If the state is 'auto' the service will be started at install time and when the system boots. =item I<-type>: optional If the type is supplied it must currently be 'interactive' to set SERVICE_INTERACTIVE_PROCESS. SERVICE_WIN32_OWN_PROCESS is assumed. =item I<-Description>: optional A brief (fewer than 256 characters) description of the service. -name will be used by default. =back =cut sub installService { my ($self, %params) = @_; my %states = (auto => 2, demand => 3, disabled => 4); Win32::MSI::HighLevel::Common::require(\%params, qw(-serviceName -Component_)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-serviceName -name -state -Component_ -Description)); $params{-name} ||= $params{-serviceName}; $params{-Description} ||= $params{-name}; $params{-state} ||= 'auto'; $params{-state} = $states{lc $params{-state}} || 2; my $type = 0x10; # SERVICE_WIN32_OWN_PROCESS $type |= 0x100 if lc $params{-type} eq 'interactive'; my %instParams = ( -ServiceInstall => $params{-serviceName}, -Component_ => $params{-Component_}, -Name => $params{-name}, -ServiceType => $type, -StartType => $params{-state}, -ErrorControl => 1, -Description => $params{-Description}, ); my $result = $self->_addServiceInstallRow(\%instParams); my $eventBits = 0xAA; # Full start/stop and delete/install processing $eventBits |= 0x01 if $params{-state} == 2; # Autostart my %ctrlParams = ( -ServiceControl => $params{-serviceName}, -Component_ => $params{-Component_}, -Name => $params{-name}, -Event => $eventBits, ); $result = $self->_addServiceControlRow(\%ctrlParams); return; } =head3 option Set various optional behavior. =over =item fixExtraSep Fix the separator bug which can generates bogus identifiers for Component names and in other situations. Note that this can lead to components with different names in installers where this setting has changed state and lead to bad behavior when updating installed components. =back =cut sub option { my ($self, $option, $value) = @_; if ($option eq 'fixExtraSep') { $self->{extraSep} = '.'; return; } die "Invalid option type passed to option: $option\n"; } =head3 populateTables Read the current .msi file and build an internal representation of it. An optional boolean parameter may be passed. If set true C will warn about any table files it finds that it doesn't know how to generate an internal representation for. Such unknown tables can not be manipulated and will be written to the output unchanged. =cut sub populateTables { my ($self, $warn) = @_; my $tables = $self->view(-table => '_Tables'); while (my $tableName = $tables->fetch()) { my $name = $tableName->string('Name'); $self->{tables}{$name} ||= {_created => 1}; if ( !exists $self->{knownTables}{$name} or !defined $self->{knownTables}{$name}) { warn "Don't know how to populate $name tables" if $warn and !exists $self->{knownTables}{$name}; $self->{knownTables}{$name} = undef; # Only warn about entry once next; } my $table = $self->view(-table => $name); while (my $rec = $table->fetch()) { $rec->populate(); $rec->{state} = Win32::MSI::HighLevel::Record::kClean; $self->{knownTables}{$name}->($self, $rec); } } continue { $tableName = 0; } # Fix any missing File table information my $fileTable = $self->{tables}{File}; for my $fileId (keys %{$fileTable}) { my $row = $fileTable->{$fileId}; next unless ref $row; unless (defined $row->{-FileSize}) { my $fullPath = $self->_getFullFilePath($row); $row->{-FileSize} = -s $fullPath || undef; } $row->{-Attributes} ||= 0; } $tables = 0; } =head3 registerExtension Add table entries to register a file extension and hook it up to an application. Note that Extension, ProgId and Verb tables may be affected by this call depending on the parameters supplied. $msi->registerExtension ( -Extension => 'myext', -Component_ => $componentId, -ProgId => 'MyApp.Data.1', -Feature_ => $featureId, -Description => 'MyApp data file', -Verb => 'Open', -Argument => '%1', ); =over 4 =item I<-Argument>: optional Command line argument to be used when launching the application. %1 may be used to pass the file on the command line. =item I<-Component_>: required Id of the component that controls installation of the extension. =item I<-Extension>: required File extension (excluding the .) that is to be registered. If multiple extensions need to be mapped to the same ProgId an array reference may be used for the value of this parameter: $msi->registerExtension (..., -Extension => [qw(myext1 myext2)], ...); =item I<-Description>: optional Text that is shown in explorer for the file type. =item I<-Feature_>: required Feature that supplies the application associated with the extension. =item I<-Icon_>: optional Entry in the Icon table that supplies an icon used for files of this type. =item I<-iconFile>: optional Path to the file containing the icon referred to by I<-IconIndex>. Note that the file name must be a unique icon file name independently of the path and must only contain alphanumeric characters, periods and underscores. This is because I forms an ID that is used internally to identify the specific icon file. Multiple extensions may use the same icon file so it is important that I can generate a one to one mapping between the file name and the internally generated ID. =item I<-IconIndex>: optional Index to the icon resource in the file provided by the I<-Icon_> table entry (which may be provided using I<-iconFile>). =item I<-MIME_>: optional MIME table Content Type entry specifying the MIME type of the contents of files of this extension. A C<-MIMECLSID> is required if this parameter is supplied. =item I<-MIMECLSID>: optional CLSID for the COM server that is associated with the MIME type for files of this extension type. This parameter is required only if a C<-MIME_> parameter is provided. =item I<-ProgId_>: optional ProgId table entry for the application associated with the file extension. Note that several extensions may reference the same ProgId. However, if more than one extension references the same ProgId the I<-Description> and I<-Icon*> parameters for the first registered (or pre-existing) entry is used. =item I<-ProgId_Parent>: optional =item I<-Verb>: optional Explorer's right click menu entry text for an action associated with files of this type. If a I<-Verb> parameter is supplied a I<-ProgId_> is required also. =back =cut sub registerExtension { my ($self, %params) = @_; my $table = $self->{tables}{Registry} ||= {}; my @return; Win32::MSI::HighLevel::Common::require(\%params, qw(-Component_ -Extension -Feature_)); Win32::MSI::HighLevel::Common::allow( \%params, qw(-Argument -Component_ -Extension -Description -Feature_ -Icon_ -iconFile -IconIndex -MIME_ -ProgId_ -ProgId_Parent -Verb) ); $self->autovivifyTables(qw(Extension ProgId Verb)); $params{-Extension} = [$params{-Extension}] unless 'ARRAY' eq ref $params{-Extension}; croak "Component id must exist before a file extension is hooked up referencing is" unless exists $self->{tables}{Component}{lc $params{-Component_}}; croak "Feature id must exist before a file extension is hooked up referencing is" unless exists $self->{tables}{Feature}{lc $params{-Feature_}}; # Update the Extension table for each extension for my $extension (@{$params{-Extension}}) { my %rec = ( -Extension => $extension, -Component_ => $params{-Component_}, -Feature_ => $params{-Feature_}, ); $rec{-ProgId_} = $params{-ProgId_} if exists $params{-ProgId_}; $rec{-MIME_} = $params{-MIME_} if exists $params{-MIME_}; $rec{-lu} = "$params{-Component_}/$extension"; push @return, $self->_addRow('Extension', 'lu', \%rec); # Update the MIME table if required if (exists $params{-MIME_}) { my %rec = ( -Extension_ => $extension, -ContentType => $params{-MIME_}, -CLSID => $params{-MIMECLSID}, ); $rec{-lu} = "$params{-ContentType}/$extension"; $self->_addRow('MIME', 'lu', \%rec); } # Update the Verb table if required if (exists $params{-Verb}) { my %rec = (-Extension_ => $extension, -Verb => $params{-Verb}); $rec{-Sequence} = $params{-Sequence} if exists $params{-Sequence}; $rec{-Command} = $params{-Command} if exists $params{-Command}; $rec{-Argument} = $params{-Argument} if exists $params{-Argument}; $rec{-lu} = "$extension/$params{-Verb}"; $self->_addRow('Verb', 'lu', \%rec); } } croak "An -IconIndex and either a -iconFile or -Icon_ parameter must be provided if any are provided" unless Win32::MSI::HighLevel::Common::noneOf(\%params, qw(-iconFile -IconIndex -Icon_)) or exists $params{-IconIndex} && 1 == Win32::MSI::HighLevel::Common::someOf(\%params, qw(-iconFile -Icon_)); if (exists $params{-iconFile}) { # Create Icon table entry if required and generate icon Id $params{-Icon_} = $self->addIconFile($params{-iconFile}); } if (exists $params{-ProgId_}) { # Update the ProgId table my %rec = (-ProgId => $params{-ProgId_}); $rec{-ProgId_Parent} = $params{-ProgId_Parent} if exists $params{-ProgId_Parent}; $rec{-Class_} = $params{-Class_} if exists $params{-Class_}; $rec{-Description} = $params{-Description} if exists $params{-Description}; $rec{-Icon_} = $params{-Icon_} if exists $params{-Icon_}; $rec{-IconIndex} = $params{-IconIndex} if exists $params{-IconIndex}; $self->_addRow('ProgId', 'ProgId', \%rec); } return @return; } =head3 setProduct Set various product related information. $msi->setProduct ( -Language => 1033, -Name => 'Wibble', -Version => '1.0.0', -Manufacturer => 'Wibble Mfg. Co.' ); For a new installer this should be called before any addComponent calls are made as information from the product details is used to generate information required to generate component table entries. Property table entries are generated or updated by this call. In addition to the properties discussed in conjunction with the parameters described below, a ProductCode value is generated and added to the Property table. The product code value is returned. =over 4 =item I<-Name>: required Product name. =item I<-Manufacturer>: required Manufacturer's name. =item I<-Language>: required Language code (LangId). =item I<-Version>: required Product version =item I<-upgradeCode>: optional A GUID that will be used as the UpgradeCode for Upgrade table entries and is used as part of the string used to generate Component GUIDs. If not provided C will generate an UpgradeCode GUID using the -Name and -Manufacturer values. By default this will allow different language version of a product to be upgraded interchangeably. Do not include version information in -Name if you rely on the default UpgradeCode GUID generation unless the version information is invariant across all product versions you expect to be able to upgrade. For most upgrade purposes this means that including a major version number in the name is OK, but including a minor version number is not. =back =cut sub setProduct { my ($self, %params) = @_; my $table = $self->{tables}{Property} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-Language -Manufacturer -Name -Version)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Language -Manufacturer -Name -upgradeCode -Version)); my $guid = $params{-upgradeCode}; if (!$guid) { my $prodStr = "$params{-Manufacturer} $params{-Name}"; $guid = Win32::MSI::HighLevel::Common::genGUID($prodStr); } $self->setProperty(-Property => 'UpgradeCode', -Value => $guid); $self->setProperty( -Property => 'ProductLanguage', -Value => $params{-Language} ); $self->setProperty(-Property => 'ProductName', -Value => $params{-Name}); $self->setProperty( -Property => 'ProductVersion', -Value => $params{-Version} ); $self->setProperty( -Property => 'Manufacturer', -Value => $params{-Manufacturer} ); return $self->_genProductCode(); } =head3 setProperty (see also L) Set a property value in the Property table. The property is added if it didn't exist already. $msi->setProperty (-Property => 'Manufacturer', -Value => 'Wibble Corp.'); The previous value is returned or C is returned if a new property is added. =over 4 =item I<-Property>: required Property name =item I<-Value>: required Property value =back =cut sub setProperty { my ($self, %params) = @_; my $table = $self->{tables}{Property} ||= {}; Win32::MSI::HighLevel::Common::require(\%params, qw(-Property -Value)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-Property -Value)); if (exists $table->{lc $params{-Property}}) { my $property = $table->{lc $params{-Property}}; $property->{-Value} = $params{-Value}; $property->{state} = Win32::MSI::HighLevel::Record::kDirty; return $property->{-Property}; } else { return $self->addProperty(%params); } } =head3 setTableEntryField Sets specified fields in an existing table entry. $msi->setTableEntryField ( 'Control', {-Dialog_ => 'Start_Installation_Dialog', -Control => InstallNow}, {-Text => 'Install'} ); The first hash ref parameter must include entries for all the table's key fields. Note that this method provides fairly raw access to table entries and does not perform very much validation. In particular fields that are linked to other tables should not be altered using L! =cut sub setTableEntryField { my ($self, $table, $keys, $values) = @_; my $key = join '/', map {$keys->{$_}} sort keys %$keys; croak "No table: $table" unless exists $self->{tables}{$table}; croak "No entry $key for table $table" unless exists $self->{tables}{$table}{lc $key}; my $entry = $self->{tables}{$table}{lc $key}; exists $entry->{$_} or croak "Field $_ does not exist in $key entry for $table table" for keys %$values; $entry->{$_} = $values->{$_} for keys %$values; $entry->{state} = Win32::MSI::HighLevel::Record::kDirty; return $entry; } =head3 tableRows Returns the count of the rows in a given table. my $count = $msi->tableRows ('File'); A single parameter giving the name of the table is required. C is returned if the table does not exist. =cut sub tableRows { my ($self, $table) = @_; return undef unless exists $self->{tables}{$table}; return scalar grep /^[^_]/, keys %{$self->{tables}{$table}}; } =head3 updateTableEntry Update the table column data for a table entry obtained using getTableEntry. my $entry = $msi->getTableEntry ('File', {-File => 'wibble.exe'}); $entry->{-File} = 'Wibble.exe'; $msi->updateTableEntry ($entry); Use with caution. In particular, do not create new keys in the hash. =cut sub updateTableEntry { my ($self, $entry) = @_; croak "Invalid table entry" unless defined $entry and exists $entry->{state} and exists $entry->{'!name'}; my $name = $entry->{'!name'}; my $key = $entry->{'!key'}; my $lu = $entry->{'!lu'}; croak "Don't know how to update $name tables" unless exists $self->{knownTables}{$name}; # Delete previous table entry $self->_deleteRow($name, $key, $lu); delete $entry->{'!lu'}; delete $entry->{'!key'}; delete $entry->{'!name'}; # Add the updated table entry $entry->{state} = Win32::MSI::HighLevel::Record::kNew; $self->{knownTables}{$name}->($self, $entry); } =head3 view Creates a Win32::MSI::HighLevel::View into the database. my $view = $msi->view (-table => 'Feature'); Generally other ways of manipulating the database are more useful than through a view. However a Win32::MSI::HighLevel::View can be created to search tables for specific information using the C<-columns>, C<-where>, C<-order> and C<-tables> parameters to return selected records. =cut sub view { my ($self, %params) = @_; $params{-columns} ||= ['*']; Win32::MSI::HighLevel::Common::listize(\%params, qw(column table)); Win32::MSI::HighLevel::Common::require(\%params, qw(-tables)); Win32::MSI::HighLevel::Common::allow(\%params, qw(-columns -order -tables -table -where)); my $query = "SELECT " . join(', ', @{$params{-columns}}); $query .= " FROM " . join(', ', @{$params{-tables}}); $query .= " WHERE $params{-where}" if exists $params{-where}; $query .= " ORDER BY " . join(', ', @{$params{-order}}) if exists $params{-order}; return Win32::MSI::HighLevel::View->new($self, %params, query => $query); } =head3 writeTables Write changes that have been made to the tables using the add* members. Until writeTables is called the changes that have been made are cached in memory. writeTables writes these changes through to the .msi database in preparation for a L. L also updates the SecureCustomProperties property with Upgrade table L properties. =cut sub writeTables { my $self = shift; # First update SecureCustomProperties my $scp = $self->getProperty('SecureCustomProperties') || ''; my %properties = map {$_ => 1} split ';', $scp; for my $tableColumn ( [Upgrade => '-ActionProperty'], [LaunchCondition => '-secureProperties'], [InstallExecuteSequence => '-secureProperties'], ) { my ($table, $column) = @$tableColumn; next unless exists $self->{tables}{$table}; for my $entry (keys %{$self->{tables}{$table}}) { my $row = $self->{tables}{$table}{$entry}; next if ! ref $row || ! exists $row->{$column}; next if $entry =~ /^_/; # Ignore flags $properties{$row->{$column}} = 1; } } $scp = join ';', sort keys %properties; $self->setProperty(-Property => 'SecureCustomProperties', -Value => $scp) if length $scp; for my $tableName (sort keys %{$self->{tables}}) { $self->createTable(-table => $tableName) unless _readonlyTable($tableName) or exists $self->{tables}{$tableName}{_created}; my $table = $self->view(-table => $tableName); my $fieldHash = $self->{tables}{$tableName}; croak "Table $tableName requires a root entry but none was provided" if exists $fieldHash->{_root} and !defined $fieldHash->{_root}; print "Updating table $tableName\n" if $self->{-noisy} & kReportUpdates; my $rec = $table->createRecord(); # Add/update/delete rows for my $key (sort keys %$fieldHash) { next if $key =~ /^(_|-[a-z])/; my $rowData = $fieldHash->{$key}; next if defined $rowData->{state} and $rowData->{state} == Win32::MSI::HighLevel::Record::kClean; my @columns = map {my $k = $_; $k =~ s/^-//; $k} grep {/^-[A-Z]/} keys %$rowData; defined $rowData->{"-$_"} and $rec->setValue($_, $rowData->{"-$_"}) for @columns; $rec->{state} = $rowData->{state}; $key ||= ''; if ($rowData->{state} == Win32::MSI::HighLevel::Record::kDelete) { (my $realKey = $key) =~ s/^\*//; print "Deleting: $tableName/$realKey\n" if $self->{-noisy} & kReportUpdates; } else { print "Writing: $tableName/$key\n" if $self->{-noisy} & kReportUpdates; } $rowData->{state} == Win32::MSI::HighLevel::Record::kNew ? $rec->insert() : $rec->update(); if ($rec->getState() == Win32::MSI::HighLevel::Record::kDelete) { delete $fieldHash->{$key}; } else { $rowData->{state} = $rec->getState(); } $rec->clearFields(); next; } } return 1; } # _addXxxRow routines handle adding table row information to the internal # representation of the database. They call through to _addRow which expects a # table name, row look up key name (excluding - prefix), the record and an # optional auxiliary look up string. See _addRow for look up key details. sub _addBinaryRow { my ($self, $rec) = @_; return $self->_addRow('Binary', 'Name', $rec, $rec->{-Name}); } sub _addAppSearchRow { my ($self, $rec) = @_; _genLu($rec, qw(Property Signature_)); return $self->_addRow('AppSearch', 'lu', $rec); } sub _addComponentRow { my ($self, $rec) = @_; return $self->_addRow('Component', 'Component', $rec, "$rec->{-Directory_}/$rec->{-KeyPath}"); } sub _addConditionRow { my ($self, $rec) = @_; return $self->_addRow('Feature_', 'Feature_', $rec); } sub _addControlRow { my ($self, $rec) = @_; _genLu($rec, qw(Control Dialog_)); return $self->_addRow('Control', 'lu', $rec); } sub _addControlConditionRow { my ($self, $rec) = @_; _genLu($rec, qw(Control_ Dialog_ Action Condition)); return $self->_addRow('ControlCondition', 'lu', $rec); } sub _addControlEventRow { my ($self, $rec) = @_; _genLu($rec, qw(Argument Condition Control_ Dialog_ Event)); return $self->_addRow('ControlEvent', 'lu', $rec); } sub _addCreateFolderRow { my ($self, $rec) = @_; _genLu($rec, qw(Component_ Directory_)); return $self->_addRow('CreateFolder', 'lu', $rec); } sub _addCustomActionRow { my ($self, $rec) = @_; return $self->_addRow('CustomAction', 'Action', $rec); } sub _addDialogRow { my ($self, $rec) = @_; return $self->_addRow('Dialog', 'Dialog', $rec); } sub _addDirectoryRow { my ($self, $rec) = @_; _checkId($rec->{-Directory}); _checkId($rec->{-Directory_Parent}) if length $rec->{-Directory_Parent}; if ( $rec->{-Directory} eq 'TARGETDIR' && $rec->{-DefaultDir} eq 'SourceDir' && !length $rec->{-Directory_Parent}) { my $table = $self->{tables}{Directory}; $table->{_root} = $rec->{-Directory}; _checkId($rec->{-DefaultDir}); } else { _checkDefaultDir($rec->{-DefaultDir}); } my $lu = $rec->{-Directory}; $lu ||= ":root:"; $lu .= "/$rec->{-Directory_Parent}"; return $self->_addRow('Directory', 'Directory', $rec, $lu); } sub _addDrLocator { my ($self, $rec) = @_; return $self->_addRow('DrLocator', 'Signature_', $rec); } sub _addMsiDriverPackagesRow { my ($self, $rec) = @_; return $self->_addRow('MsiDriverPackages', 'Component', $rec); } sub _addFeatureRow { my ($self, $rec) = @_; $self->{tables}{Feature} ||= {}; unless (defined $rec->{-Feature_Parent} and length $rec->{-Feature_Parent}) { my $table = $self->{tables}{Feature}; $table->{_root} = $rec->{-Feature}; } $rec->{-name} ||= $rec->{-Feature}; return $self->_addRow('Feature', 'Feature', $rec, $rec->{-name}); } sub _addFeatureComponentsRow { my ($self, $rec) = @_; _genLu($rec, qw(Component_ Feature_)); return $self->_addRow('FeatureComponents', 'lu', $rec, $rec->{-lu}); } sub _addFileRow { my ($self, $rec) = @_; my $files = $self->{tables}{File}; $rec->{-Sequence} = $self->_nextSeqNum($rec->{-File}, $rec->{-Sequence}); $self->_addRow('File', 'File', $rec, "$rec->{-Component_}/$rec->{-FileName}"); return $rec->{-File}; } sub _addIconRow { my ($self, $rec) = @_; return $self->_addRow('Icon', 'Name', $rec); } sub _addInstallExecuteSequenceRow { my ($self, $rec) = @_; return $self->_addRow('InstallExecuteSequence', 'Action', $rec, $rec->{-Sequence}); } sub _addInstallUISequenceRow { my ($self, $rec) = @_; return $self->_addRow('InstallUISequence', 'Action', $rec, $rec->{-Sequence}); } sub _addLaunchConditionRow { my ($self, $rec) = @_; return $self->_addRow('LaunchCondition', 'Condition', $rec, $rec->{-Sequence}); } sub _addMediaRow { my ($self, $rec) = @_; return $self->_addRow('Media', 'DiskId', $rec, "$rec->{-Cabinet}"); } sub _addPropertyRow { my ($self, $rec) = @_; $self->_addRow('Property', 'Property', $rec, $rec->{-Property}); return $rec->{-Property}; } sub _addRegistryRow { my ($self, $rec) = @_; _genLu($rec, qw(Key Name Root)); $self->_addRow('Registry', 'lu', $rec, $rec->{-lu}); return $rec->{-Registry}; } sub _addRegLocatorRow { my ($self, $rec) = @_; $self->_addRow('RegLocator', 'Signature_', $rec); return $rec->{-Registry}; } # $key must be a key into the hash referenced by $rec. Often it will be a table # field. Where more than one field is a key field a synthetic key may be # generated by: # _genLu ($rec, qw(Key1 Key2 ...)); # and 'lu' is passed in as the $key value. # The key entries MUST be sorted by column name! # Where a lookup by something other than the table key is required the $lu # parameter may be provided. A {lookup}{tableName}{$lu} entry is then generated # to provide a mapping from the lookup key to the actual table entry. # Note that keys that match /^(_|-[a-z])/ are retained by _addRow but are # ignored by table processing. sub _addRow { my ($self, $tableName, $key, $rec, $lu) = @_; my $table = $self->{tables}{$tableName} ||= {}; my $hashKey = lc $rec->{"-$key"}; croak "-$key missing from $tableName table entry.\n" . "This may be a HighLevel bug where '-lu' should be used for the lookup key" unless exists $rec->{-$key}; if (exists $table->{$hashKey}) { croak "Duplicate $key $rec->{-$key} entry not allowed in $tableName table" unless $rec->{skipDup}; return $rec->{-$key}; } my @keys = grep {/^-/} keys %$rec; @{$table->{$hashKey}}{@keys} = @{$rec}{@keys}; if (defined $lu) { $lu = lc $lu; $self->{lookup}{$tableName}{$lu} = $hashKey; $self->{id_idToKey}{$tableName}{lc $rec->{-$key}} = $lu; } if ($rec->{state}) { $table->{$hashKey}{state} = $rec->{state}; } else { $table->{$hashKey}{state} = Win32::MSI::HighLevel::Record::kNew; } return $rec->{-$key}; } sub _addSelfRegRow { my ($self, $rec) = @_; return $self->_addRow('SelfReg', 'File_', $rec); } sub _addServiceControlRow { my ($self, $rec) = @_; return $self->_addRow('ServiceControl', 'ServiceControl', $rec); } sub _addServiceInstallRow { my ($self, $rec) = @_; return $self->_addRow('ServiceInstall', 'ServiceInstall', $rec); } sub _addShortcutRow { my ($self, $rec) = @_; _genLu($rec, qw(Directory_ Target)); return $self->_addRow('Shortcut', 'Shortcut', $rec, $rec->{-lu}); } sub _addSignatureRow { my ($self, $rec) = @_; return $self->_addRow('Signature', 'Signature', $rec, $rec->{-Signature}); } sub _addStorageRow { my ($self, $rec) = @_; return $self->_addRow('_Storages', 'Name', $rec, $rec->{-Name}); } sub _addUpgradeRow { my ($self, $rec) = @_; _genLu($rec, qw(UpgradeCode VersionMin VersionMax Language Attributes)); return $self->_addRow('Upgrade', 'lu', $rec, $rec->{-lu}); } #sub _getFullSourceDirPath { # my ($self, $dir) = @_; # my $dirTable = $self->{tables}{Directory}; # my @path; # # $dir = $dir->{-Directory} if ref $dir; # # while (defined $dir and exists $dirTable->{$dir}) { # my $entry = $dirTable->{$dir}; # my $parent = $entry->{-Directory_Parent}; # my $defDir = $entry->{-DefaultDir}; # my ($sourceDir, $targetDir) = $entry->{-DefaultDir} =~ /^(\S+?)(?::(.*))?$/; # # $sourceDir ||= $targetDir; # $dir = $parent; # # next if $sourceDir eq '.'; # # my @pair = @{$self->_dirPair ($sourceDir)}; # # $sourceDir = $pair[1]; # $sourceDir = $pair[0] unless length $sourceDir; # $sourceDir = $self->{-SourceRoot} if $sourceDir eq 'SOURCEDIR'; # # unshift @path, $sourceDir; # } # # return join '\\', @path; #} sub _buildDirLookup { my $self = shift; return if exists $self->{tables}{Directory}{_byDir}; # Build directory lookup hashes from existing table entries for my $Directory (keys %{$self->{tables}{Directory}}) { next if $Directory =~ /^_/; # Skip special entries my $row = $self->{tables}{Directory}{$Directory}; my ($targetDir, $sourceDir) = $row->{-DefaultDir} =~ /^([^:]+)(?::(.*))?$/; my $parent = $row->{-Directory_Parent}; $sourceDir ||= $targetDir; if (!defined $sourceDir or !defined $targetDir) { croak("Directory information not available."); } $sourceDir = $self->_dirPair($sourceDir); $targetDir = $self->_dirPair($targetDir); $self->{DirLookup}{lc $sourceDir->[1]}{$row->{-Directory}} = $row; $self->{DirLookup}{lc $sourceDir->[0]}{$row->{-Directory}} = $row if lc $sourceDir->[1] ne lc $sourceDir->[0]; my $id = $row->{-Directory}; my $key = $sourceDir->[1]; $self->{id_idToKey}{$id} = $key; $self->{id_keyToId}{$key} = $id; } $self->{tables}{Directory}{_byDir} = 1; } sub _checkId { my $id = shift; croak "Invalid Identifier: $id" unless $id =~ /^[_a-z][\w.]*$/i; } sub _checkDefaultDir { my ($dir) = @_; Carp::croak() unless defined $dir; my ($target, $source) = $dir =~ /(^[^:]+)(?::(.*))?$/; _checkFilename($target, 'Target directory') unless $target eq '.'; _checkFilename($source, 'Source directory') if defined $source; } sub _checkFilename { my ($filename, $type) = @_; my $badLong = '\?|><:/*"'; my $badShort = "$badLong+,;=[] \t\n\r"; my ($short, $long) = $filename =~ /(^[^|]+)(?:\|(.*))?$/; $short = '' unless defined $short; $type ||= 'Filename'; croak "Invalid $type (bad short filename character): '$filename'." if $short =~ /[$badShort]/; croak "Invalid $type (bad short filename 8.3 format): '$filename'." if $short !~ /^[^.]{0,8}(?:\.[^.]{0,3})?$/; croak "Invalid $type (short filename must be provided): '$filename'." if !length $short; croak "Invalid $type (bad long filename character). None of $badLong allowed: '$filename'." if defined $long and $long =~ /[$badLong]/; } sub _deleteRow { my ($self, $name, $key, $lu) = @_; my $rec = $self->{tables}{$name}{$key}; if ($self->{tables}{$name}{$key}{state} > Win32::MSI::HighLevel::Record::kNew) { # Schedule DB row for deletion $self->{tables}{$name}{$key}{state} = Win32::MSI::HighLevel::Record::kDelete; $self->{tables}{$name}{"*$key"} = {%{$self->{tables}{$name}{$key}}}; } delete $self->{tables}{$name}{$key}; if (defined $lu) { $lu = lc $lu; delete $self->{lookup}{$name}{$lu} if exists $self->{lookup}{$name}; delete $self->{id_idToKey}{$name}{$rec->{-$key}} if exists $self->{id_idToKey}{$name}; } } sub _dirPair { my ($self, $pairStr) = @_; my ($short, $long) = $pairStr =~ /([^|]+)\|?(.*)/; $long ||= $short; $short ||= $self->{dp_longToShort}{lc $long}; $short ||= $self->_longToShort($long); $self->{dp_longToShort}{lc $long} ||= $short; return [$short, $long]; } sub _findFileId { my ($self, $target) = @_; my ($path, $file) = $target =~ m!(.*)[\\/](.*)!; $file = lc $file; $path = lc $path; my @candidates = grep {lc($self->{tables}{File}{$_}{-FileName}) eq $file} grep {$_ !~ /^_/} keys %{$self->{tables}{File}}; my $match; for my $fileId (@candidates) { next unless lc $self->{tables}{File}{$fileId}{-targetDir} eq $path; $match = $file; last; } return $match; } # _genLu generates a lookup string for the key fields in a table. # If a single 'key' is passed in a table name is assumed and the key # list is generated. # If multiple keys are passed in they are used directly. sub _genLu { my ($rec, @keys) = @_; @keys = createTable(0, _keys => $keys[0]) if @keys == 1; !defined $rec->{"-$_"} and $rec->{"-$_"} = '' for @keys; $rec->{-lu} = join '/', map $rec->{"-$_"}, sort @keys; } sub _genProductCode { my ($self) = @_; my $manufacturer = $self->getProperty('Manufacturer'); my $language = $self->getProperty('ProductLanguage'); my $name = $self->getProperty('ProductName'); my $version = $self->getProperty('ProductVersion'); return if grep {!defined} ($manufacturer, $language, $name, $version); $self->{prodNamespace} = "$manufacturer/$language/$name/$version"; my $prodCode = Win32::MSI::HighLevel::Common::genGUID($self->{prodNamespace}); $self->setProperty(-Property => 'ProductCode', -Value => $prodCode); $self->{productCode} = $prodCode; return $prodCode; } sub _getFullFilePath { my ($self, $file) = @_; return $file->{-path} if exists $file->{-path}; return undef; } # Generate a unique Id to be used as a table key entry. # # $id is a source id - often a file name or user supplied id # $context is generally a table name # $length is the maximum generated id length # $extra may be provided to disambiguate between id's - often a file path sub _getUniqueID { # $context should be the bare table name if the id is a table key (eg # 'File') my ($self, $reqId, $context, $length, $extra) = @_; my $id = $reqId; my $key; return $self->{id_keyToId}{$context}{$key} if $self->_haveUniqueId($id, $context, $extra, $key); $length ||= 38; $id =~ tr/a-zA-Z0-9_.//cd; $id =~ s/^[\d.]+//; $id = substr $id, 0, $length; Carp::croak "'$reqId' can not be used as an id.\n" . " An id must only contain letters, digits, _ and . characters and\n" . " must start with a letter. Characters not allowed in an id have\n" . " been removed from the requested id" if !length $id; my $lcId = lc $id; while (exists $self->{id_idToKey}{$context}{$lcId}) { if ($id =~ /(?{id_idToKey}{$context}{$lcId} = $key; $self->{id_keyToId}{$context}{$key} = $id; return $id; } # Check to see if an id has been generated already for a given context. # Sets $key sub _haveUniqueId { $_[2] ||= 'global' unless defined $_[2]; # Init $context my ($self, $id, $context, $extra) = @_; $extra ||= ''; my $key = lc "$id$self->{extraSep}$extra"; $key =~ s/^[^|]*\|//; # Retain only long file name portion $_[4] = $key if exists $_[4]; # 'Return' key if (exists $self->{id_keyToId}{$context}{$key}) { return $self->{id_keyToId}{$context}{$key}; } else { return undef; } } sub _longAndShort { my ($self, $long) = @_; my $short = $self->_longToShort($long); return $short if $short eq $long; return "$short|$long"; } sub _longToShort { my ($self, $long) = @_; return $self->{dp_longToShort}{lc $long} if exists $self->{dp_longToShort}{lc $long}; my $short = $long; unless ($short =~ /^([^\0-\037<>:;.,="\/\|[\] ]){1,8}(\.[^\0-\037<>:;.,="\/\|[\] ]{1,3})?$/ ) { $short = uc $short; # Remove bad characters $short =~ s/[\0-\037<>:;,="\/\|[\] ]//g; # Remove all except the last full stop $short =~ s/\.(?=.*\.)//g; # Truncate to 6.3 with ~1 appended to the name part $short =~ s/^(.{1,6})(?:(?!(?=\.[^.]*$)).)*(\..{1,3}|)(?:[^.]*)$/$1~1$2/; while (exists $self->{dp_shortToLong}{$short}) { if ($short =~ /~9+(?=[^\d])/) { $short =~ s/(.*)\w~(\d+)/"$1~1" . ('0' x length $2)/e; } else { my ($digits) = $short =~ /(?<=~)(\d+)/; $short =~ s/(?<=~)(\d+)/$digits + 1/e; } } } $self->{dp_shortToLong}{$short} = $long; $self->{dp_longToShort}{lc $long} = $short; return $short; } sub _readonlyTable { my $table = shift; return $table =~ /^(_Storages|_Columns|_Streams|_Tables|_TransformView)$/; } sub _nextSeqNum { my ($self, $fileId, $seed) = @_; my $scan = $seed ||= $self->{nextSeqNum}++; my $files = $self->{tables}{File}; while (exists $self->{usedSeqNum}{$scan}) { # Move present file up one slot and replace with new file my $mvFileId = $self->{usedSeqNum}{$scan}; $files->{$fileId}{-Sequence} = $scan; $self->{usedSeqNum}{$scan} = $fileId; $files->{$mvFileId}{-Sequence} = ++$scan; $self->{usedSeqNum}{$scan} = $mvFileId; $fileId = $mvFileId; } $self->{usedSeqNum}{$seed} = $fileId; $self->{highestSeqNum} = $scan if $self->{highestSeqNum} < $scan; $self->{highestSeqNum} = $self->{nextSeqNum} if $self->{highestSeqNum} < $self->{nextSeqNum}; return $seed; } 1; =head1 REMARKS This module depends on C, which is used to import the functions out of the F. Microsoft's Windows Installer technology must be installed on your system for this module to work. =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT This module is supported by the author through CPAN. The following links may be of assistance: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS This module was inspired by, and is derived in part from Philipp Marek's L. =head1 AUTHOR Peter Jaquiery CPAN ID: GRANDPA grandpa@cpan.org =head1 COPYRIGHT & LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =head1 SEE ALSO Microsoft MSDN Installer Database documentation: L =cut