#!/usr/bin/perl
#
# Script to generate an FLWM menu based on XDG .desktop files
#
# Copyright: 2017-2018 Axel Beckert <abe@debian.org>
# License: GPL-2+
# (See debian/copyright or /usr/share/doc/flwm/copyright for details.)

use strict;
use warnings;
use 5.010;
use autodie;

use File::DesktopEntry;
use Path::Tiny;
use File::Which;
use Set::Scalar;

my $desktop_dir = path('/usr/share/applications/');
my $target_dir  = path('/var/lib/flwm/wmx/Free Desktop/');

# c.f. https://standards.freedesktop.org/menu-spec/latest/apa.html
my $main_categories = Set::Scalar->new(
    qw(
    AudioVideo
    Audio
    Video
    Development
    Education
    Game
    Graphics
    Network
    Office
    Science
    Settings
    System
    Utility
    ));

my $desktop_categories = Set::Scalar->new(
    qw(
    KDE
    GNOME
    LXQt
    XFCE
    ));

my %useless_combination = (
    'KDE/Qt'    => 1,
    'LXQt/Qt'   => 1,
    'GNOME/GTK' => 1,
    'XFCE/GTK'  => 1,
    );

# Add /usr/games to $PATH because it's usually not in root's $PATH,
# but we need it for File::Which finding games under /usr/games/.
$ENV{PATH} = $ENV{PATH}.':/usr/games';

# Virginify target directory
$target_dir->remove_tree;
$target_dir->mkpath;

# Just exit gracefully if /usr/share/applications/ doesn't exist.
exit(0) unless $desktop_dir->exists;

# Get all .desktop files
my @desktop_files = $desktop_dir->children( qr{ \.desktop $ }x );

foreach my $desktop_file (@desktop_files) {
    my $desktop_pt = path($desktop_file);

    # Weed out broken symbolic links
    next unless $desktop_pt->exists;

    # Filter out localized non-UTF-8 values as they tend to make
    # File::DesktopEntry to barf and we don't need them anyways.
    my $desktop_raw = join('',
                           grep { !/\.(CP1251|KOI8-)/ }
                           $desktop_pt->lines);

    # Finally parse the file
    my $desktop_entry = File::DesktopEntry->new(\$desktop_raw);

    # Skip files without Exec, Name or Type entry
    next unless defined $desktop_entry->get('Exec');
    next unless defined $desktop_entry->get('Type');
    next unless defined $desktop_entry->get('Name');

    # Skip files which aren't of Type=Application or have NoDisplay=true
    next unless $desktop_entry->get('Type') eq 'Application';
    my $nodisplay = $desktop_entry->get('NoDisplay');
    next if defined($nodisplay) and $nodisplay eq 'true';

    # Skip files where Exec wants a single file, URI or
    # directory. (It's actually unclear in the specification if %f, %u
    # and %u need exactly one parameter or only at most one
    # parameter. Assuming the former and hence skipping such files.)
    next if $desktop_entry->get('Exec') =~ m( \% [fud] )x;

    my $program    = $desktop_entry->parse_Exec();
    my $name       = $desktop_entry->get('Name');
    my $categories = $desktop_entry->get('Categories') || 'Uncategorized';
    my $terminal   = $desktop_entry->get('Terminal') || 'false';

    # Check name for suitability as file name and fix it if necessary.
    $name =~ s{/}{-}g;

    # The ConsoleOnly category is special and equivalent to Terminal=true
    if ($categories =~ m/ \b ConsoleOnly \b /x or
        $terminal eq 'true') {
        $program = "x-terminal-emulator -e '$program'";
    }

    # Check if it's more than just a path, e.g. contains parameters
    if ($program =~ m( ['"] )x or $program =~ m( \s )x) {
        write_shell_script($categories, $name, $program, $desktop_file)
    }

    # Check if the program is already an absolute path or not
    elsif ($program =~ m( ^ / )x) {
        create_symlink($categories, $name, $program, $desktop_file);
    } else {
        my $path = which($program);
        unless (defined $path) {
            warn "$program from $desktop_file cannot be found in \$PATH, skipping";
            next
        }
        create_symlink($categories, $name, $path, $desktop_file);
    }
}

sub write_shell_script {
    my ($categories, $name, $script, $desktop_file) = @_;

    foreach my $cat (extract_categories($categories)) {
        my $cat_dir = subdir($target_dir, $cat);
        my $path = check_duplicates($cat_dir->child($name), $desktop_file);
        $path->spew("#!/bin/sh\n", "exec $script\n");
        $path->chmod(0755);
    }
}

sub create_symlink {
    my ($categories, $name, $target, $desktop_file) = @_;

    foreach my $cat (extract_categories($categories)) {
        my $cat_dir = subdir($target_dir, $cat);
        symlink($target, check_duplicates($cat_dir->child($name),
                                          $desktop_file));
    }
}

sub extract_categories {
    my $categories = shift;
    my $result_categories = Set::Scalar->new();

    # Condense multiple semicolons into one
    $categories =~ s/ ;;+ /;/x;

    # Remove trailing semicolons
    $categories =~ s/ ; $ //x;

    # Generate array of categories and filter them
    my $all_categories = Set::Scalar->new(
        # Blacklist any category starting with X-
        grep { ! /^X-/ }
        split(/;/, $categories)
        );

    # Check if a at least one main section is defined
    my $included_main_categories =
        $all_categories * ( $main_categories + $desktop_categories );
    unless ($included_main_categories->is_empty) {
        my $remaining_categories = $all_categories - $main_categories;
        foreach my $main_cat ($included_main_categories->members) {
            my $prefixed_categories = Set::Scalar->new(
                map { "$main_cat/$_" }
                grep {
                    $main_cat ne $_ and
                        !exists($useless_combination{"$main_cat/$_"})
                }
                $remaining_categories->members
                );
            $result_categories += $prefixed_categories;
        }
    } else {
        $result_categories += $all_categories;
    }

    return $result_categories->members;
}

sub subdir {
    my ($target_dir, $cat) = @_;

    my $cat_dir = $target_dir->child($cat);
    $cat_dir->mkpath;

    return $cat_dir;
}

sub check_duplicates {
    my ($path, $desktop_file) = @_;
    if (-e $path) {
        $path = $path->sibling($path->basename .
                               ' (' .
                               $desktop_file->basename('.desktop') .
                               ')');
    }

    return $path;
}
