#!/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;
}