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] );