#!/usr/bin/perl
# (c) Copyright 2005-2012, 2014. CodeWeavers, Inc.
use warnings;
use strict;

my @desktop_plugins=("CXAssocWindows", "CXAssocCheck",
                     "CXAssocMailcap", "CXAssocDebian", "CXAssocCDE",
                     "CXAssocXDG", "CXAssocMacOSX");


# Portable which(1) implementation
sub cxwhich($$;$)
{
    my ($dirs, $app, $noexec)=@_;
    if ($app =~ /^\//)
    {
        return $app if ((-x $app or $noexec) and -f $app);
    }
    elsif ($app =~ /\//)
    {
        require Cwd;
        my $path=Cwd::cwd() . "/$app";
        return $path if ((-x $path or $noexec) and -f $path);
    }
    else
    {
        foreach my $dir (split /:/, $dirs)
        {
            return "$dir/$app" if ($dir ne "" and (-x "$dir/$app" or $noexec) and -f "$dir/$app");
        }
    }
    return undef;
}

# Fast dirname() implementation
sub _cxdirname($)
{
    my ($path)=@_;
    return undef if (!defined $path);
    return "." if ($path !~ s!/+[^/]+/*$!!s);
    return "/" if ($path eq "");
    return $path;
}

# Locate where CrossOver is installed by looking for the directory
# where the cxmenu script is located, unwinding symlinks on the way
sub locate_cx_root(;$)
{
    my ($fallback)=@_;
    my $argv0=cxwhich($ENV{PATH},$0);
    $argv0=$0 if (!defined $argv0);
    if ($argv0 !~ m+^/+)
    {
        require Cwd;
        $argv0=Cwd::cwd() . "/$argv0";
    }
    my $dir=_cxdirname($argv0);
    my $bindir=$dir;
    $bindir =~ s%/lib$%/bin%;
    while (!-x "$bindir/cxmenu" or !-f "$bindir/cxmenu")
    {
        last if (!-l $argv0);
        $argv0=readlink($argv0);
        $argv0="$dir/$argv0" if ($argv0 !~ m+^/+);
        $dir=_cxdirname($argv0);
        $bindir=$dir;
        $bindir =~ s%/lib$%/bin%;
    }
    $bindir =~ s%/(?:\./)+%/%g;
    $bindir =~ s%/\.$%%;
    $ENV{CX_ROOT}=_cxdirname($bindir);
    if ((!-x "$ENV{CX_ROOT}/bin/cxmenu" or !-f "$ENV{CX_ROOT}/bin/cxmenu") and
        $fallback)
    {
        $ENV{CX_ROOT}=$fallback;
    }
    if (!-x "$ENV{CX_ROOT}/bin/cxmenu" or !-f "$ENV{CX_ROOT}/bin/cxmenu")
    {
        my $name0=$0;
        $name0 =~ s+^.*/++;
        print STDERR "$name0:error: could not find CrossOver in '$ENV{CX_ROOT}'\n";
        exit 1;
    }
    return $ENV{CX_ROOT};
}

BEGIN {
    unshift @INC, locate_cx_root() . "/lib/perl";
}
use CXLog;
use CXUtils;
use CXAssoc;

my $filters;
sub get_filter_list($$)
{
    my ($cxassoc, $filter)=@_;

    $filter=lc($filter || "");
    my $filter_list=$filters->{$filter};
    if (!defined $filter_list)
    {
        my @list;
        if ($filter eq "")
        {
            @list=$cxassoc->get_section_names();
        }
        else
        {
            @list=split /:+/, $filter;
        }
        $filters->{$filter}=$filter_list=\@list;
    }
    return $filter_list;
}

sub get_install_mode($$$)
{
    my ($eassocid, $hash_mode, $default_mode)=@_;
    foreach my $mode ("default", "alternative", "mime", "ignore")
    {
        if (defined $hash_mode->{$mode} and
            $eassocid =~ /^(?:$hash_mode->{$mode})$/i)
        {
            return $mode;
        }
    }
    return $default_mode;
}

sub update_field($$$)
{
    my ($section, $name, $value)=@_;

    $value||="";
    my $oldval=$section->get($name, "");
    return 0 if ($oldval eq $value);

    if ($value eq "")
    {
        $section->remove($name);
    }
    else
    {
        $section->set($name, $value);
    }
    return 1;
}

sub normalize_eassocid($)
{
    my ($eassocid)=@_;
    $eassocid =~ tr/A-Z/a-z/;
    return map { mangle_string(demangle_string($_)) } split "/", $eassocid;
}

sub valid_mimetype($)
{
    my ($mimetype)=@_;
    my @parts=split m%/%, $mimetype;
    return (@parts == 2);
}

sub maybe_capitalize($)
{
    my ($str)=@_;
    return ucfirst($str) if ($str !~ /[A-Z]/);
    return $str;
}

my %mode_to_score=(
    default     => 0,
    alternative => 1,
    mime        => 2,
    ignore      => 3
);

sub build_assoc_db($)
{
    my ($cxassoc)=@_;

    my $std_verb_names=CXAssoc::std_verb_names();
    my ($massocs, $eassocs, $winmimes, $winexts, %extmimes);
    foreach my $eassocid ($cxassoc->get_section_names())
    {
        my $section=$cxassoc->get_section($eassocid);
        my @parts=split "/", $eassocid;
        if (@parts > 3)
        {
            cxwarn("too many parts in '$eassocid'\n");
            next;
        }
        my $ext=demangle_string($parts[0] || "");
        if (!$ext or $ext !~ s/^\.// or $ext =~ m%[/\\]%)
        {
            cxwarn("invalid extension for association '$eassocid'\n");
            next;
        }
        # Don't demangle $appid and $verb just yet
        my $appid=$parts[1] || "";
        my $verb=$parts[2] || "";
        cxlog("$eassocid -> [$ext | $appid | $verb]\n");

        # Validate and normalise MimeType, Mode and Type
        my $mimetype=$section->get("MimeType", "");
        if ($mimetype ne "" and !valid_mimetype($mimetype))
        {
            cxwarn("invalid MIME type '$mimetype' for association '$eassocid'\n");
            next;
        }
        if (!defined $extmimes{$ext})
        {
            $extmimes{$ext}=$mimetype;
        }
        elsif ($extmimes{$ext} ne $mimetype)
        {
            cxwarn("the '$ext' extension has inconsistent MIME types. Using '$extmimes{$ext}' instead of '$mimetype'\n");
            $mimetype=$extmimes{$ext};
        }

        my $mode=$section->get("Mode", "ignore");
        $mode =~ tr/A-Z/a-z/;
        $mode =~ s/^alternate$/alternative/i;
        if ($mode !~ /^(?:default|alternative|mime|ignore)$/)
        {
            cxwarn("unknown Mode '$mode' for '$eassocid'\n");
            $mode="ignore";
        }
        my $type=$section->get("Type", "raw");
        $type =~ tr/A-Z/a-z/;

        # Create the EAssoc object
        my $eassoc={
            id          => $eassocid,
            ext         => $ext,
            appid       => $appid,
            verb        => $verb,
            verbname    => $section->get("VerbName") ||
                           $std_verb_names->{$verb} ||
                           maybe_capitalize(demangle_string($verb)),
            stdverbname => 0,
            mode        => $mode,

            # Stored here so we can later populate the MAssoc and Mime objects
            localize    => $section->get("Localize"),
            description => $section->get("Description", ""),
            infotip     => $section->get("InfoTip", ""),
            appname     => $section->get("AppName", ""),
            type        => $type,
            icon        => expand_string($section->get("Icon", "")),
            command     => expand_cmdline($section->get("Command", ""))
        };
        my $stdname=$std_verb_names->{$verb};
        if ($eassoc->{verbname} and $stdname and
            ($eassoc->{verbname} eq $stdname or
             $eassoc->{verbname} eq CXAssoc::remove_accelerators($stdname)))
        {
            # Tag the verb so we can try to localize it
            $eassoc->{stdverbname}=1;
        }
        $eassocs->{$eassocid}=$eassoc;

        # Then the 'Extension MIME type'
        my $emimetype="application/x-crossover-$ext";
        my $emime=$winmimes->{$emimetype};
        if (!defined $emime)
        {
            $emime={
                mimetype    => $emimetype,
                exts        => { $ext => 1 },
                real        => 0
            };
            $winmimes->{$emimetype}=$emime;
        }
        $emime->{eassocs}->{$eassocid}=$eassoc;
        $eassoc->{emime}=$emime;

        # The real MIME type if any
        my $mime;
        if ($mimetype)
        {
            $mime=$winmimes->{$mimetype};
            if (!defined $mime)
            {
                $mime={
                    mimetype    => $mimetype,
                    real        => 1
                };
                $winmimes->{$mimetype}=$mime;
            }
            $mime->{exts}->{$ext}=1;
            $mime->{eassocs}->{$eassocid}=$eassoc;
        }

        # Link the extension to the corresponding MIME type
        $winexts->{$ext}=$mime || $emime;

        # And finally the MAssoc object
        my $massocid=mangle_string($mimetype || $emimetype);
        $massocid.=":$appid" if ($appid or $verb);
        $massocid.=":$verb" if ($verb);
        my $massoc=$massocs->{$massocid};
        if (!defined $massoc)
        {
            $massoc={
                id          => $massocid,
                appid       => $appid,
                verb        => $verb,
                mime        => $mime || $emime
            };
            $massocs->{$massocid}=$massoc;
        }
        # Extra MIME types are simply put all together
        foreach my $extramime (split /:+/, $section->get("ExtraMimeTypes", ""))
        {
            if (!valid_mimetype($extramime))
            {
                cxwarn("ignoring invalid extra MIME type $extramime\n");
                next;
            }
            $massoc->{extramimes}->{$extramime}=1;
        }
        $massoc->{eassocs}->{$ext}=$eassoc;
        $eassoc->{massoc}=$massoc;

        # Choose a reference EAssoc from which we can compute the type,
        # command, etc. This is the EAssoc with the 'highest' install mode
        # i.e. the lowest score
        if (!$massoc->{ref_eassoc} or
            $mode_to_score{$mode} < $mode_to_score{$massoc->{mode}})
        {
            $massoc->{ref_eassoc}=$eassoc;
            $massoc->{mode}=$eassoc->{mode};
        }
    }

    foreach my $massoc (values %$massocs)
    {
        my $ref_eassoc=$massoc->{ref_eassoc};
        $massoc->{type}=$ref_eassoc->{type};
        $massoc->{command}=$ref_eassoc->{command};
        cxlog("  $massoc->{id} | $massoc->{type} | $massoc->{mode}\n");

        foreach my $eassoc (values %{$massoc->{eassocs}})
        {