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

Discussion in 'Perl Misc' started by Graham, Aug 28, 2005.

  1. Graham

    Graham Guest

    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, Aug 28, 2005
    #1
    1. Advertisements

  2. Graham

    Graham Guest

    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::Dumper;
    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::Dumper->Dump( [$image] );
     
    Graham, Aug 28, 2005
    #2
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.