1 files changed, 186 insertions, 0 deletions
diff --git a/wix/filelist.pl b/wix/filelist.pl
new file mode 100755
index 0000000..1a83109
--- /dev/null
+++ b/wix/filelist.pl
@@ -0,0 +1,186 @@
+#!/usr/bin/perl -w
+
+use Fcntl;
+use File::Find;
+use File::Basename;
+use Getopt::Long;
+
+
+# Options
+#
+$usage = "usage: filelist.pl "            .
+         "-out <file> "                   .
+         "-dir <dir> "                    .
+         "-ref-id <dir-id> "              .
+         "-comp-id <component-group-id> " .
+         "[-ignore <file-name>] "         .
+         "[-prefix <dir>]";
+
+$out = "";
+$dir = "";
+$ref_id = "";
+$comp_id = "";
+$prefix = "";
+
+@ignore = ();
+
+GetOptions ("out=s" => \$out,
+            "dir=s" => \$dir,
+            "ref-id=s" => \$ref_id,
+	    "comp-id=s" => \$comp_id,
+	    "ignore=s@" => \@ignore,
+	    "prefix=s" => \$prefix);
+
+die "$usage\n" unless ($out ne "" &&
+		       $dir ne "" &&
+		       $ref_id ne "" &&
+		       $comp_id ne "");
+
+#
+#
+%ids = ();
+@components = ();
+
+sysopen (OUT, $out, O_WRONLY | O_CREAT | O_TRUNC) ||
+    die "unable to create $out: $!";
+
+print (OUT "<?xml version='1.0' encoding='windows-1252'?>\n");
+print (OUT "<Wix xmlns='http://schemas.microsoft.com/wix/2006/wi'>\n");
+print (OUT "<Fragment Id='$dir-fragment'>\n\n");
+
+# Directories and components.
+#
+print (OUT "<DirectoryRef Id='$ref_id'>\n");
+
+traverse ($dir, $prefix ne "" ? "$prefix/$dir" : $dir);
+
+print (OUT "</DirectoryRef>\n\n");
+
+# Component group.
+#
+print (OUT "<ComponentGroup Id='$comp_id'>\n");
+
+for $comp (@components)
+{
+    print (OUT "<ComponentRef Id='$comp'/>\n");
+}
+
+print (OUT "</ComponentGroup>\n\n");
+
+print (OUT "</Fragment>\n");
+print (OUT "</Wix>\n");
+close (OUT) || die "unable to close $out: $!";
+
+
+
+#
+#
+sub traverse
+{
+    my $short_path = shift;
+    my $full_path = shift;
+
+    my @files = ();
+    my @dirs = ();
+
+    opendir (DIR, $full_path) or die "unable to open $full_path: $!";
+
+    while (defined ($file = readdir (DIR)))
+    {
+	next if $file =~ /^\.\.?$/; # skip . and ..
+
+	my $path = "$full_path/$file";
+
+
+	if (-d $path)
+	{
+	    push @dirs, ($file);
+	}
+	elsif (-f $path)
+	{
+	    my $n = grep $_ eq $file, @ignore;
+	    if (!$n)
+	    {
+		push @files, ($file);
+	    }
+	}
+	else
+	{
+	    die "unknown directory entity: $file in $full_path";
+	}
+    }
+
+    closedir (DIR);
+
+    gen_component ($short_path, $full_path, @files);
+
+    for $d (@dirs)
+    {
+	print (OUT "<Directory Id='" . id ("$short_path/$d-dir") . "' Name='$d'>\n");
+	traverse ("$short_path/$d", "$full_path/$d");
+	print (OUT "</Directory>\n");
+    }
+}
+
+sub gen_component
+{
+    my $short_path = shift;
+    my $full_path = shift;
+    my @files = @_;
+
+    if (scalar (@files) > 0)
+    {
+	my $guid = trim (uc (`uuidgen`));
+	my $cid = id ("$short_path-comp");
+	print (OUT "<Component Id='$cid' Guid='$guid'>\n");
+
+	for $file (@files)
+	{
+	    print (OUT "<File Id='" . id ("$short_path/$file-file") . "' Name='$file' Source='$full_path/$file' DiskId='1' Vital='yes'/>\n");
+	}
+
+	print (OUT "</Component>\n");
+	push @components, ($cid);
+    }
+}
+
+sub id
+{
+    my $str = shift;
+    $str =~ s/[-\\\/.+~]/_/g;
+
+    # Ids cannot be longer than 72. Instead we will make it 69 and
+    # reserve three elements for disambiguing.
+    #
+    if (length ($str) > 69)
+    {
+    	$str = substr ($str, 0, 69);
+    }
+
+    my $n = 1;
+    my $base = $str;
+
+    while (exists ($ids{$str}))
+    {
+	if ($n > 999)
+	{
+	    die "unable to make a unique id for $base\n";
+	}
+
+	$str = "$base$n";
+	$n++;
+    }
+
+    $ids{$str} = undef;
+
+    return $str;
+}
+
+# Perl trim function to remove whitespace from the start and end of the string
+sub trim($)
+{
+	my $string = shift;
+	$string =~ s/^\s+//;
+	$string =~ s/\s+$//;
+	return $string;
+}