Problems with PerlMSI, part of ActiveState's Perl Development Kit 6.0

[Graham]

I'm a newbie to ActiveState's PDK.I bought it for two products - PerlApp &
PerlMSI. PerlApp is fine, no worries, but Perl MSI seems a bit of a
shambles. First problem was that I had to edit some code within msiwiz.pl
just to get the thing to run. Then, when I run the script msiwiz.pl produces
and which is supposed to write the actual MSI installer database file, it
goes so far then says 'Can't call method "AddFile" on an undefined value at
C:\Program Files\ActiveState Dev Kit 6.0\lib\/MSI/Image.pm line 100'. I've
fooled around with inserting a few 'my's into Image.pm, but can't seem to
solve the problem.

ActiveState are a bit slow in providing support - anyone experienced this
problem before?

 

[Graham]

Before folk ask me for it (and at the risk of infringing copyright), here is
Image.pm in full



package MSI::Image;

use strict;
use Carp;
use Cwd;
use MSI::File;
use MSI::Component;
use File::Find;
use Data:umper;
use Win32::Cabinet;

require 5.6.0;

our $COMPONENT_FILES = 'exe|dll|chm';
my $IMAGEROOT;

use constant DEFAULT_DIR_ROOT => 'TARGETDIR';


###############################################################################
#
# MSI::Image->new($imageRoot, [ $keyGUID ])
#
sub new {
my ($proto, $imageRoot, $keyGUID) = @_;
my $class = ref $proto || $proto;
my $self = bless {}, $class;
$self->{'KeyGUID'} = $keyGUID;
$self->{'Data'} = [];
$self->{'DirectoryList'} = {};
$self->{'ComponentList'} = {};
$self->{'FileList'} = {};
$self->{'DirectoryRoot'} = DEFAULT_DIR_ROOT;
$self->CreateImage($imageRoot) if $imageRoot;
return $self;
}

###############################################################################
#
# $self->CreateImage($imageRoot)
#
sub CreateImage {
my ($self, $imageRoot) = @_;
croak "Directory '$imageRoot' does not exist!" unless -d $imageRoot;
($self->{ImageRoot} = $imageRoot) =~ s#\\#/#g;

my $reap = sub {
my $ctx = $self;
my $ful_path = $File::Find::name;
(my $rel_path = $ful_path) =~ s#$ctx->{ImageRoot}/##;
return if m#^\.\.?$#;
if (-d $_) {
#rem $rel_path =~ m#.*?/?([^/]+)/?([^/]*)$#;
$rel_path =~ m/(.*)[\\\/](.*$)/;
my $parent = $1;
my $default = $2;

$parent = "\U$parent";

my $DirectoryKey = StrToUKey($rel_path);
if(not $default) {
$default = $rel_path;
$parent = DEFAULT_DIR_ROOT;
}

# Get short filename
if (length($default) > 8){
# my $short_name = Win32::GetShortPathName(scalar
Win32::GetFullPathName($ful_path));
my $short_name = Win32::GetShortPathName(scalar
Win32::GetFullPathName($default));
$short_name =~ s/.*[\\\/](.*)/$1/;
$default = $short_name . '|' . $default;
}

$parent =~ s/[^a-zA-Z0-9\.]/_/g;
$ctx->{DirectoryList}->{$rel_path} = {
Directory => $DirectoryKey,
Directory_Parent => $parent,
DefaultDir => $default
};

my $component = MSI::Component->new($rel_path);
$component->Directory($DirectoryKey);
$ctx->{ComponentList}->{$DirectoryKey} = $component;
$component->ComponentID($rel_path);
}elsif (-f $_) {
my $file = MSI::File->new($_, $rel_path);
(my $component_dir = $rel_path) =~ s#(.*)/.*#$1#;
my $DirectoryKey = StrToUKey($component_dir);

# Check if this file has one of our component extensions
if (m#\.($COMPONENT_FILES)$#i) {
my $ComponentKey = StrToKey($rel_path);
$file->Component($ComponentKey);
my $component = MSI::Component->new($rel_path);
$component->Directory($DirectoryKey);
$component->ComponentID($rel_path =~ s#^/##);
$component->KeyPath($ComponentKey);
$ctx->{ComponentList}->{$ComponentKey} = $component;
}else {
$ctx->{ComponentList}->{$DirectoryKey}->AddFile($file);
}

$ctx->{FileList}->{$rel_path} = $file;
}
else {
die 'What am I doing here?';
}
};

find($reap, $self->{'ImageRoot'});
}

###############################################################################
#
# $self->GetDirectory($directory_name)
#
sub GetDirectory {
my $self = shift;
my $path = shift;
croak "Directory '$path' does not exist in image!" unless exists
$self->{'DirectoryList'}->{$path};
return $self->{'DirectoryList'}->{$path};
}

###############################################################################
#
# $self->GetComponent($component_name)
#
sub GetComponent {
my $self = shift;
my $component_name = shift;
my $component_key = StrToKey($component_name);
my $component_ukey = StrToUKey($component_name);
if (exists $self->{ComponentList}->{$component_key}) {
return $self->{ComponentList}->{$component_key};
} elsif (exists $self->{ComponentList}->{$component_ukey}) {
return $self->{ComponentList}->{$component_ukey};
} else {
croak "Component '$component_name' does not exist in image!";
}
}

###############################################################################
#
# $self->GetFile($file_name)
#
sub GetFile {
my $self = shift;
my $path = shift;
croak "File '$path' does not exist in image!" unless exists
$self->{'FileList'}->{$path};
return $self->{'FileList'}->{$path};
}

###############################################################################
#
# $self->DirectoryList()
#
sub DirectoryList {
my $self = shift;
return map { $self->{DirectoryList}->{$_} } keys
%{$self->{DirectoryList}};
}

###############################################################################
#
# $self->ComponentList()
#
sub ComponentList {
my $self = shift;
return map { $self->{ComponentList}->{$_} } keys
%{$self->{ComponentList}};
}

###############################################################################
#
# $self->FileList()
#
sub FileList {
my $self = shift;
return map { $self->{FileList}->{$_} } keys %{$self->{FileList}};
}

###############################################################################
#
# $self->SetComponentFeature($name, $feature, [ $is_dir ], [ $recurse ])
#
sub SetComponentFeature {
my ($self, $name, $feature, $add, $recurse) = @_;
my $ComponentKey = StrToKey($name);
my $ComponentUKey = StrToUKey($name);
croak "Component '$name' does not exist in image!"
unless (exists $self->{ComponentList}->{$ComponentKey}
or exists $self->{ComponentList}->{$ComponentUKey}
);

if($recurse) {
foreach my $key (keys %{$self->{ComponentList}}) {
if($key =~ m#^$ComponentKey#
or $key =~ m#^$ComponentUKey#
) {
print $key, " => ", $feature, "\n";
$add or ($self->{ComponentList}->{$key}->{Features} = {});
$self->{ComponentList}->{$key}->{Features}->{$feature} = 1;
}
}
}
else {
if($add){#it is directory
$self->{ComponentList}->{$ComponentUKey}->{Features}->{$feature}
= 1;
}else{
$self->{ComponentList}->{$ComponentKey}->{Features} = {};
$self->{ComponentList}->{$ComponentKey}->{Features}->{$feature}
= 1;
}
}
}

###############################################################################
#
# $self->SetComponentAttributes($name, $attrs, [ $is_dir ], [ $recurse ])
#
sub SetComponentAttributes {

my ($self, $name, $attrs, $recurse) = @_;

croak "Component '$name' does not exist in image!"
unless exists $self->{ComponentList}->{$name};

if($recurse) {
foreach my $key (keys %{$self->ComponentList}) {
if($key =~ m#^$name#) {
$self->{ComponentList}->{$key}->Attributes($attrs);
}
}
}
else {
$self->{ComponentList}->{$name}->Attributes($attrs);
}
}

###############################################################################
#
# $self->SetFileComponent($name, $component)
#
sub SetFileComponent {

my ($self, $name, $component) = @_;

croak "Component '$component' does not exist in image!"
unless exists $self->{ComponentList}->{$name};

croak "File '$component' does not exist in image!"
unless exists $self->{ComponentList}->{$name};

$self->{FileList}->{$name}->Component($component);
}

###############################################################################
#
# $self->SetFileAttributes($name, $attrs, [ $is_dir ], [ $recurse ])
#
sub SetFileAttributes {

my ($self, $name, $attrs, $recurse) = @_;

croak "File '$name' does not exist in image!"
unless exists $self->{FileList}->{$name};

if($recurse) {
foreach my $key (keys %{$self->FileList}) {
if($key =~ m#^$name#) {
$self->{FileList}->{$key}->Attributes($attrs);
}
}
}
else {
$self->{FileList}->{$name}->Attributes($attrs);
}
}

sub MakeCabinet {
my ($self, $start_seq, $filename) = @_;
my $cabinet = Win32::Cabinet->new;

if(!$cabinet->Create('Foo', $filename, './')) {
croak "Error creating cabfile $filename!" if !$cabinet;
}


foreach my $fileid (keys %{$self->{FileList}}) {
my $file = $self->{FileList}->{$fileid};
$file->Sequence($start_seq++);
$cabinet->AddFile($self->{ImageRoot} . '/' . $file->PathName,
$file->File, 0)
or croak "Error adding ", $file->PathName, " to cabfile: $filename";
}

$cabinet->Write() or croak "Error writing cabfile $filename";
return $start_seq;
}

sub StrToKey{
# my $self = shift;
my $str = shift;
if(defined $str){$str =~ tr/
\\\/\-\+\*\&\#\$\@\(\)\{\}\[\];:'",<>?=~!/_/;}
return $str;
}
sub StrToUKey{
# my $self = shift;
my $str = shift;
if(defined $str){$str =~ tr/a-z
\\\/\-\+\*\&\#\$\@\(\)\{\}\[\];:'",<>?=~!/A-Z_/;}
return $str;
}


1;

__END__

my $image = MSI::Image->new('../../img', 'XXX555OOO');
$image->SetFileAttributes('Perl', 1024, 1);
print Data:umper->Dump( [$image] );