File Coverage

DB.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

line

stmt

bran

cond

sub

pod

time

code

package Win32::MSI::DB;

=head1 NAME

Win32::MSI::DB - Modify MSI databases

=head1 SYNOPSIS

use Win32::MSI::DB;

$database = Win32::MSI::DB::new("filename", $flags);

$database->transform("filename", $flags);

$table = $database->table("table");

$view = $database->view("SELECT * FROM File WHERE FileSize < ?", 100000);

@rec = $table->records();

$rec4 = $table->record(4);

$rec->set("field", "value"); # string

$rec->set("field", 4); # int

$rec->set("field", "file"); # streams

$rec->get("field");

$rec->getintofile("field", "file");

$field = $rec->field("field");

$field->set(2);

$data = $field->get();

$field->fromfile("autoexec.bat");

$field->intofile("tmp.aa");

$db->error();

$view->error();

$rec->error();

=head1 DESCRIPTION

=head2 Obtaining a database object

C returns a new database object, open

in one of the following modes:

=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 behaviour.

=item $Win32::MSI::MSIDBOPEN_CREATE

This creates a new database in transactional mode.

=back

A database object allows creation of Cs or Cs. If you

simply need access to a table you can use the C method; for a

subset of records or even a SQL-query you can use the C method.

=head2 Using transforms

When you have got a handle to a database, you can successively apply

transforms to it. You do this by using C, which needs the

filename of the transform file (normally with extension F<.mst>) and

optionally a flag specification.

Most of the possible flag values specify which merge errors are to be

suppressed.

=over 4

=item $Win32::MSI::MSITR_IGNORE_ADDEXISTINGROW

Ignores adding a row that already exists.

=item $Win32::MSI::MSITR_IGNORE_ADDEXISTINGTABLE

Ignores adding a table that already exists.

=item $Win32::MSI::MSITR_IGNORE_DELMISSINGROW

Ignores deleting a row that doesn't exist.

=item $Win32::MSI::MSITR_IGNORE_DELMISSINGTABLE

Ignores deleting a table that doesn't exist.

=item $Win32::MSI::MSITR_IGNORE_UPDATEMISSINGROW

100

101

Ignores updating a row that doesn't exist.

102

103

=item $Win32::MSI::MSITR_IGNORE_CHANGECODEPAGE

104

105

Ignores that the code pages in the MSI database and the transform file

106

do not match and neither has a neutral code page.

107

108

=item $Win32::MSI::MSITR_IGNORE_ALL

109

110

This flag combines all of the above mentioned flags. This is the

111

default.

112

113

=item $Win32::MSI::MSITR_VIEWTRANSFORM

114

115

This flag should not be used together with the other flags. It

116

specifies that instead of merging the data, a table named

117

C<_TransformView> is created in memory, which has the columns

118

C, C, C, C and C.

119

120

This way the data in a transform file can be directly queried.

121

122

For more information please see

123

124

125

=back

126

127

This doesn't open the file read-only, but changes will not be written

128

to disk.

129

130

A transform is a specification of changed values. So you get a MSI

131

database from your favorite vendor, make a transform to overlay your

132

own settings (the target installation directory, the features to be

133

installed, etc.) and upon installation you can use these settings via

134

a commandline similar to

135

136

msiexec /i TRANSFORMS = F F /qb

137

138

The changes in a transform are stored by a (table, row, cell, old

139

value, new value) tuple.

140

141

=head2 Fetch records from a table or view

142

143

When you have obtained a C or C object, you can use the

144				C method to access individual records. It takes a number as
145				parameter. Records are fetched as needed. Using C as parameter
146				fetches all records and returns the first (index 0).
147
148				Another possibility is to use the C method, which returns an
149				array of all records in this table or view.
150
151				=head2 A record has fields
152
153				A record's fields can be queried or changed using the C
154				object, as in
155
156				$rec->set("field", "value"); # string
157				$rec->set("field", 4); # int
158				$rec->set("field", "file"); # streams
159
160				$rec->get("field");
161				$rec->getintofile("field", "file");
162
163				or you can have separate C objects:
164
165				$field = $rec->field("field");
166
167				$data = $field->get();
168				$field->set(2);
169
170				Access to files (streams) is currently not finished.
171
172				=head2 Errors
173
174				Each object may access an C method, which gives a string or an
175				array (depending on context) containing the error information.
176
177				Help wanted: Is there a way to get a error string from the number
178				which does not depend on the current MSI database? In particular, the
179				developer errors (2000 and above) are not listed.
180
181				=head1 REMARKS
182
183				This module depends on C, which is used to import the
184				functions out of the F.
185
186				Currently the C is not used - patches are welcome.
187
188				=head2 AUTHOR
189
190				Please contact C for questions, suggestions, and
191				patches (C please).
192
193				A big thank you goes to DBH for various changes throughout the code.
194
195				=head2 Further plans
196
197				A C package is planned - which will allow to
198				compare databases and give a diff, and similar tools.
199
200				I have started to write a simple Tk visualization.
201
202				=head1 SEE ALSO
203
204				S
205
206				=cut
207
208	1	1	16802	use strict;
	1		2
	1		42
209	1	1	6	use warnings;
	1		2
	1		33
210
211	1	1	1644	use Win32::API;
	0
	0
212
213				our $VERSION = "1.06";
214
215				###### Constants and other definitions
216
217				# Shorthand to define API call constants
218				sub _def
219				{
220				return Win32::API->new("msi", @_, "I") \|\| die $!;
221				}
222
223				my $MsiOpenDatabase = _def(MsiOpenDatabase => "PPP");
224				my $MsiOpenDatabasePIP = _def(MsiOpenDatabase => "PIP");
225				my $MsiCloseHandle = _def(MsiCloseHandle => "I");
226				my $MsiDataBaseCommit = _def(MsiDatabaseCommit => "I");
227				my $MsiDatabaseApplyTransform = _def(MsiDatabaseApplyTransform => "IPI");
228				my $MsiViewExecute = _def(MsiViewExecute => "II");
229				my $MsiDatabaseOpenView = _def(MsiDatabaseOpenView => "IPP");
230				my $MsiViewClose = _def(MsiViewClose => "I");
231				my $MsiViewFetch = _def(MsiViewFetch => "IP");
232				my $MsiRecordGetFieldCount = _def(MsiRecordGetFieldCount => "I");
233				my $MsiRecordGetInteger = _def(MsiRecordGetInteger => "II");
234				my $MsiRecordGetString = _def(MsiRecordGetString => "IIPP");
235				my $MsiRecordGetStringIIIP = _def(MsiRecordGetString => "IIIP");
236				my $MsiRecordSetInteger = _def(MsiRecordSetInteger => "III");
237				my $MsiRecordSetString = _def(MsiRecordSetString => "IIP");
238				my $MsiRecordSetStream = _def(MsiRecordSetStream => "IIP");
239				my $MsiCreateRecord = _def(MsiCreateRecord => "I");
240				my $MsiViewGetColumnInfo = _def(MsiViewGetColumnInfo => "IIP");
241				my $MsiGetLastErrorRecord = _def(MsiGetLastErrorRecord => "");
242				my $MsiFormatRecord = _def(MsiFormatRecord => "IIPP");
243
244				# External constants
245
246				our $MSIDBOPEN_READONLY = 0;
247				our $MSIDBOPEN_TRANSACT = 1;
248				our $MSIDBOPEN_DIRECT = 2;
249				our $MSIDBOPEN_CREATE = 3;
250
251				our $MSICOLINFO_NAMES = 0;
252				our $MSICOLINFO_TYPES = 1;
253				my $_MSICOLINFO_INDEX = 21231231; # For own use, not defined by MS
254
255				our $MSITR_IGNORE_ADDEXISTINGROW = 0x1;
256				our $MSITR_IGNORE_DELMISSINGROW = 0x2;
257				our $MSITR_IGNORE_ADDEXISTINGTABLE = 0x4;
258				our $MSITR_IGNORE_DELMISSINGTABLE = 0x8;
259				our $MSITR_IGNORE_UPDATEMISSINGROW = 0x10;
260				our $MSITR_IGNORE_CHANGECODEPAGE = 0x20;
261				our $MSITR_VIEWTRANSFORM = 0x100;
262
263				our $MSITR_IGNORE_ALL =
264				$MSITR_IGNORE_ADDEXISTINGROW \|
265				$MSITR_IGNORE_DELMISSINGROW \|
266				$MSITR_IGNORE_ADDEXISTINGTABLE \|
267				$MSITR_IGNORE_DELMISSINGTABLE \|
268				$MSITR_IGNORE_UPDATEMISSINGROW \|
269				$MSITR_IGNORE_CHANGECODEPAGE;
270
271				my $MSI_NULL_INTEGER = -0x80000000;
272				my $ERROR_NO_MORE_ITEMS = 259;
273				my $ERROR_MORE_DATA = 234;
274
275				my $COLTYPE_STREAM = 1;
276				my $COLTYPE_INT = 2;
277				my $COLTYPE_STRING = 3;
278				my %COLTYPES = (
279				"i" => $COLTYPE_INT,
280				"j" => $COLTYPE_INT,
281				"s" => $COLTYPE_STRING,
282				"g" => $COLTYPE_STRING,
283				"l" => $COLTYPE_STRING,
284				"v" => $COLTYPE_STREAM,
285				);
286
287				my $INITIAL_EMPTY_STRING = "\0" x 1024;
288
289				##### Default Routines
290
291				sub new
292				{
293				my ($file, $mode) = @_;
294
295				return undef unless ($file);
296
297				my $hdl = pack("l",0);
298				$mode = $MSIDBOPEN_TRANSACT unless (defined($mode));
299				if ($mode =~ /^\d+$/)
300				{
301				# For special values of mode another call
302				# is needed (integer instead of pointer)
303				$MsiOpenDatabasePIP->Call($file, $mode, $hdl) and return undef;
304				}
305				else
306				{
307				$MsiOpenDatabase->Call($file, $mode, $hdl) and return undef;
308				}
309
310				my %a = (handle => unpack("l", $hdl));
311
312				return _bless_type(\%a, "db");
313				}
314
315				sub DESTROY
316				{
317				my $self = shift;
318
319				$self->_commit() if ($self->{""} eq "db");
320
321				if ($self->{"handle"})
322				{
323				_close($self->{"handle"}) and return undef;
324				}
325				$self = {};
326				}
327
328				##### Public Routines
329
330				# Database method to return the records in $table, optionally
331				# qualified by SQL clause $where with parameters @param
332
333				sub table
334				{
335				my ($self, $table, $where, @param) = @_;
336
337				return undef unless (defined $table);
338
339				$self->_check("db");
340
341				my $sql = "SELECT * FROM $table" . (defined $where && " WHERE $where");
342
343				$self->view($sql, @param);
344				}
345
346				# Database method to return the view obtained by executing $sql SELECT
347				# statement with parameters @param. If $sql is not a SELECT then
348				# return an object of "type" "sql".
349
350				sub view
351				{
352				my ($self, $sql, @param) = @_;
353
354				$self->_check("db");
355
356				my $hdl = pack("l",0);
357				$MsiDatabaseOpenView->Call($self->{"handle"}, $sql, $hdl) and return undef;
358				my %s = (handle => unpack("l", $hdl));
359
360				my $a = 0;
361				if (@param)
362				{
363				$a = _newrecord(@param) or return undef;
364				}
365				$MsiViewExecute->Call($s{"handle"}, $a) and return undef;
366				_close($a) if ($a);
367
368				return _bless_type(\%s, "sql") unless ($sql =~ /^\s*SELECT\s/i);
369
370				my $me = _bless_type(\%s, "v");
371				$me->get_info(undef);
372				$me->{"coltypes"} = [ map($COLTYPES{lc(substr($_->{type}, 0, 1))},
373				@{$me->{"colinfo"}}) ];
374				return $me;
375				}
376
377				# Given a table or view, return record number $recnum. Fetch records
378				# as necessary. If $recnum is undef, fetch all records and return the
379				# first.
380
381				sub record
382				{
383				my ($self, $recnum) = @_;
384
385				$self->_check("v");
386
387				while (!defined($recnum) \|\| $recnum > $self->{"fetched"})
388				{
389				my $hdl = pack("l",0);
390				last if ($MsiViewFetch->Call($self->{"handle"}, $hdl)
391				== $ERROR_NO_MORE_ITEMS);
392				$hdl = unpack("l", $hdl);
393				$self->{"records"}[$self->{fetched} ++] =
394				_bless_type({handle => $hdl, view => $self}, "r");
395				}
396				return $self->{"records"}[$recnum \|\| 0];
397				}
398
399				sub records
400				{
401				my ($self) = @_;
402
403				$self->_check("v");
404				$self->record(undef);
405
406				return @{$self->{"records"}};
407				}
408
409				sub fields
410				{
411				return field(@_);
412				}
413
414				# Return a record's fields with names @names, or the first such in a
415				# scalar context
416
417				sub field
418				{
419				my ($self, @names) = @_;
420				my ($cn);
421
422				$self->_check("r");
423				my @ret = ();
424				for my $n (@names)
425				{
426				my $i = $self->{"view"}->get_info($_MSICOLINFO_INDEX, $n);
427				if (defined $i)
428				{
429				push @ret, bless_type({rec => $self,
430				cn => $i->{"index"}}, "f");
431				}
432				else
433				{
434				push @ret, undef;
435				}
436				}
437				return @names > 1 \|\| wantarray() ? @ret : $ret[0];
438				}
439
440				sub close
441				{
442				my $self = shift;
443
444				$self->DESTROY();
445				}
446
447				sub get
448				{
449				my ($self, $field) = @_;
450
451				$self->_check("r", "f");
452
453				if ($self->_type() eq "f") # Get the value of a field
454				{
455				return $self->{"rec"}{data}[$self->{cn}];
456				}
457
458				if (!$self->{"data"}) # Get $field from a record
459				{
460				$self->{"data"} = [_extract_fields($self->{handle},
461				@{$self->{"view"}{coltypes}} ) ];
462				}
463				my $f = $self->{"view"}->get_info($_MSICOLINFO_INDEX, $field);
464
465				return defined($f) ? $self->{"data"}[$f] : undef;
466				}
467
468				sub set
469				{
470				my ($self, $field, $value) = @_;
471				my ($rec, $cn, $type);
472
473				$self->_check("r", "f");
474
475				if ($self->_type() eq "r") # Set $field of this record
476				{
477				$rec = $self;
478				$cn = $self->{"view"}->get_info($_MSICOLINFO_INDEX, $field);
479				}
480				else # Set this field
481				{
482				$rec = $self->{"rec"};
483				$cn = $self->{"cn"};
484				$value = $field; # $field not given
485				}
486
487				$type = $rec->{"view"}{coltypes}[$cn];
488				$cn++; # MSI numbers columns from 1
489				if ($type == $COLTYPE_INT)
490				{
491				$MsiRecordSetInteger->Call($rec->{"handle"}, $cn, $value)
492				and return undef;
493				}
494				elsif ($type == $COLTYPE_STRING)
495				{
496				$MsiRecordSetString->Call($rec->{"handle"}, $cn, $value)
497				and return undef;
498				}
499				elsif ($type == $COLTYPE_STREAM)
500				{
501				$MsiRecordSetStream->Call($rec->{"handle"}, $cn, $value)
502				and return undef;
503				}
504				else
505				{
506				return undef;
507				}
508				return 1;
509				}
510
511				sub coltypes
512				{
513				my ($self) = @_;
514
515				$self->get_info($MSICOLINFO_TYPES);
516				}
517
518				sub colnames
519				{
520				my ($self) = @_;
521
522				$self->get_info($MSICOLINFO_NAMES);
523				}
524
525				# Return column names or types for this view
526				# $which =
527				# $MSICOLINFO_NAMES
528				# $MSICOLINFO_TYPES
529				# $_MSICOLINFO_INDEX => Return column index of $field
530				# undef => return whole colinfo hash
531
532				sub get_info
533				{
534				my ($self, $which, $field) = @_;
535
536				$self->_check("v");
537
538				# Fetch and store my colinfo if absent
539				if (!$self->{"colinfo"})
540				{
541				my $hdl = pack("l",0);
542				$MsiViewGetColumnInfo->Call($self->{"handle"}, $MSICOLINFO_NAMES, $hdl)
543				and return undef;
544				$hdl = unpack("l", $hdl);
545				my @name = _extract_fields($hdl);
546				_close($hdl);
547
548				$hdl = pack("l",0);
549				$MsiViewGetColumnInfo->Call($self->{"handle"}, $MSICOLINFO_TYPES, $hdl)
550				and return undef;
551				$hdl = unpack("l", $hdl);
552				my @type = _extract_fields($hdl);
553				_close($hdl);
554
555				foreach my $i (0..$#name)
556				{
557				my $n = $name[$i];
558				$self->{"colinfo_hash"}{$n} = $self->{colinfo}[$i] =
559				{name => $n, type => $type[$i], index => $i};
560				}
561				}
562
563				if (defined $which && $which == $_MSICOLINFO_INDEX)
564				{
565				return undef unless ($field);
566
567				my $t = $self->{"colinfo_hash"}{$field};
568				return $t ? $t->{"index"} : undef;
569				}
570				return !defined($which) ? %{$self->{"colinfo_hash"}} :
571				$which == $MSICOLINFO_NAMES ? map($_->{"name"}, @{$self->{colinfo}}) :
572				$which == $MSICOLINFO_TYPES ? map($_->{"type"}, @{$self->{colinfo}}) :
573				undef;
574				}
575
576				# die with $message followed by error info from $self
577
578				sub db_die
579				{
580				my ($self, @msg) = @_;
581
582				die join(" ", @msg), ": ", join("/", $self->error);
583				}
584
585				sub error
586				{
587				my ($self) = shift;
588
589				my $e = $MsiGetLastErrorRecord->Call() or return undef;
590				my @a = _extract_fields($e);
591				_close($e);
592
593				return wantarray ? @a : join("/", @a);
594				}
595
596				# XXX Errors 1000-1999 are install-time errors and their strings are
597				# stored in the Error table but errors > 2000 are MSI authoring errors
598				# and are not in the error table.
599
600				# ms-help://MS.PSDKXPSP2.1033/msi/setup/windows_installer_error_messages.htm
601
602				sub _error_string_to_do
603				{
604				my ($self, @a) = @_;
605
606				print join("<>", @a), "\n";
607				my $q = $self->openview("SELECT Message FROM Error WHERE Error = ?", $a[0])
608				or die $!;
609				push @a, $q->fetch();
610				_close($q);
611				$q = newrecord(@a) or die $!;
612				print "rec = $q\n";
613				my $s = " " x 1024;
614				my $l = pack("l", length($s));
615				$MsiFormatRecord->Call($self, $q, $s, $l) or die $!;
616				print "->$s\n";
617				substr($s, unpack("l", $l)) = "";
618
619				return $s;
620				}
621
622				sub transform
623				{
624				my ($self, $filename, $flags) = @_;
625
626				$self->_check("db");
627				return undef unless ($filename);
628
629				$flags = $MSITR_IGNORE_ALL if (!defined($flags));
630
631				my $r = $MsiDatabaseApplyTransform->Call(
632				$self->{"handle"}, $filename, $flags);
633
634				return $r;
635				}
636
637				##### Internal Routines - not for use outside this module
638
639				sub _commit
640				{
641				my $self = shift;
642
643				$MsiDataBaseCommit->Call($self->{"handle"}) and return undef;
644				}
645
646				sub _close
647				{
648				my $hdl = shift;
649
650				$MsiCloseHandle->Call($hdl) and return undef;
651				}
652
653				# Bless hash $ref into this package, setting its "type" in the hash
654				# element with an empty string key. Ugh.
655
656				sub _bless_type
657				{
658				my ($ref, $type, $class) = @_;
659
660				my $me = bless $ref, $class \|\| __PACKAGE__;
661				$me->{""} = $type;
662
663				return $me;
664				}
665
666				sub _type
667				{
668				my ($self) = @_;
669
670				return $self->{""};
671				}
672
673				sub _check
674				{
675				my ($self, @allowed) = @_;
676
677				my $t = $self->_type();
678
679				die "$self is type '$t' instead of " . join(", ", @allowed)
680				unless (grep($t eq $_, @allowed));
681				}
682
683				# Return the handle for a new record containing @list
684
685				sub _newrecord
686				{
687				my (@list) = @_;
688
689				my $hdl = $MsiCreateRecord->Call(scalar(@list)) or return undef;
690
691				for my $i (0..$#list)
692				{
693				# print "new rec. $i: ", $list[$i], " is ";
694				if ($list[$i] =~ /^\d+$/)
695				{
696				# print "int\n";
697				$MsiRecordSetInteger->Call($hdl, $i+1, $list[$i]) and return undef;
698				}
699				else
700				{
701				# print "string\n";
702				$MsiRecordSetString->Call($hdl, $i+1, $list[$i]) and return undef;
703				}
704				}
705				return $hdl;
706				}
707
708				sub _getI
709				{
710				my ($hdl, $num) = @_;
711
712				my $i = $MsiRecordGetInteger->Call($hdl, $num);
713
714				return $i == $MSI_NULL_INTEGER ? undef : $i;
715				}
716
717				sub _getS
718				{
719				my ($hdl, $num) = @_;
720				my ($len);
721
722				my $s = $INITIAL_EMPTY_STRING;
723				my $p = pack("l", length($s)); # Initial size
724				my $e = $MsiRecordGetString->Call($hdl, $num, $s, $p);
725				if ($e == $ERROR_MORE_DATA)
726				{
727				$len = unpack("l", $p)*2; # Unicode?
728				$s = "\0" x $len;
729				$e = $MsiRecordGetString->Call($hdl, $num, $s, $len);
730				}
731				die $! if ($e);
732
733				$len = unpack("l", $p);
734				return "((too big))" if ($len > length($s));
735
736				# $l = index($s, "\0");
737				# $l = length($s) if $l<0;
738
739				return substr($s, 0, $len);
740				}
741
742				# Get values of fields for $hdl. If present, @types gives the type,
743				# $COLTYPE_INT or $COLTYPE_STRING of each field; otherwise try to
744				# fetch it as an int and if that fails try string.
745
746				sub _extract_fields
747				{
748				my ($hdl, @types) = @_;
749
750				my $i = $MsiRecordGetFieldCount->Call($hdl) or die $!;
751				my @a = ();
752				for my $c (1..$i)
753				{
754				my $s;
755				if (@types)
756				{
757				my $t = shift @types;
758				$s = $t == $COLTYPE_INT ? _getI($hdl, $c) :
759				$t == $COLTYPE_STRING ? _getS($hdl, $c) :
760				undef; # STREAMS and other not processed here
761				}
762				else # Autodetect mode
763				{
764				$s = _getI($hdl, $c);
765				$s = _getS($hdl, $c) unless (defined($s));
766				}
767				push @a, $s;
768				}
769				return @a;
770				}
771
772				# vim: sw=2 ai
773