#!/bin/env perl

# Changelog
#
# 2007-08-18
# Much faster icon look up
# Icon look up preffers XDG compliant and full name icon names, in this order
# Menu items are printed in lexicographic order
#
# 2007-01-28
# NoDisplay respected

require 5.004;
use warnings;
#use diagnostics;
use strict;
use utf8;
#use locale;
use POSIX qw(locale_h);
use File::Find;

# Desktop files directory
my $APPDIR='/usr/share/applications';
# Icon dir
my @ICONDIRS=('/usr/share/pixmaps', '/usr/share/icons');

# Icon file name cache
my %icons;

# Menu item list
my @menu;

# Builds icon file name cache
# TODO: In case of same file name, select better (?) icon
sub buildiconcache {
    print STDERR "Building icon cache... ";
    find(sub { if ( -f ) {$icons{$_}=$File::Find::name;}},
        @ICONDIRS);
    print STDERR (scalar keys %icons ). " files found\n";
}

# Get locale
setlocale(LC_MESSAGES) =~ m/([^_.]*)((_([^.]*))*(.([^@]*))*)*/;
my ($l_lang, $l_teritory, $l_charset)= ($1, $4, $6);

# Set output charset
if (defined $l_charset) {
    my $encoding = ':' . lc $l_charset;
    $encoding =~ s/-//g;
    binmode STDOUT, $encoding;
}

# do cache building
buildiconcache;
#foreach (keys %icons) {
#    print "$_: $icons{$_}\n";
#};

# Iterate over desktop files
for my $file (glob "$APPDIR/*.desktop") {
    open (FILE, $file) or next;
    binmode FILE, ':utf8';

    my ($name, $name_l, $name_lt, $icon, $exec, $no_display);
    $icon='-';
    
    # Parse desktop file
    while (<FILE>) {
        chomp;

        # Switch charset of the desktop file
        if (/^Encoding=(.*)/) {
            my $encoding = ':' . lc $1;
            $encoding =~ s/-//g;
            binmode FILE, $encoding;
        }

        # Remember application name. Try to catch l10ned ones too.
        if (/^Name=\s*(.*)\s*/) {$name=$1};
        if (defined $l_lang && /^Name\[$l_lang\]=\s*(.*)\s*/) {$name_l=$1;}
        if (defined $l_lang && defined $l_teritory
            && /^Name\[${l_lang}_${l_teritory}\]=\s*(.*)\s*/) {$name_lt=$1;}

        # Icon name
        if (/^Icon=\s*(..*)\s*/) {
            my $requested_icon=$1;
            # Path missing
            if ($requested_icon !~ m/\//) {
                # TODO: select best icon type and size and prefer apps icon
                foreach (grep(/^$requested_icon/, keys %icons)) {
                    print STDERR "$file: Candidate for icon $requested_icon: "
                        . "$_\n";
                    $icon=$icons{$_};

                    # XDG spec: icon file name is ICON_NAME.EXTENSION
                    if (/^$requested_icon\.[^.]+/) {
                        print STDERR "This one is XDG compliant\n";
                        last;
                    }

                    # legacy: icon file name is ICON_NAME (i.e. involves
                    # extension)
                    if (/^$requested_icon$/) {
                        print STDERR "This one matches exactly as in pre-XDG "
                            . "age\n";
                        last;
                    }
                }
            }
            # Absolute path provided
            else {
                $icon=$requested_icon;
            }
        }

        # Executable name
        if (/^Exec=\s*(.*)\s*/) {
            $exec=$1;
            # TODO: Where to get simple exec command?
            # Just remove all escape sequences.
            $exec =~ s/%\S//g;
        }

        # Prgram should not appear in the menu
        if (/^NoDisplay=(.*)/) {
            if ($1 =~ /true/i) { $no_display='true'; }
        }

        # TODO: WM_CLASS remote call, console programs.
    }

    # Select most l10ned name
    if (defined $name_lt) {$name=$name_lt;}
    elsif (defined $name_l) {$name=$name_l;}
   
    # Save menu entry intro menu list
    if (!$no_display) {
        push (@menu, {name=>"$name", icon=>"$icon", exec=>"$exec"});
    }

    close(FILE);
}

# Print sorted menu
foreach (sort{ $a->{name} cmp $b->{name} } @menu) {
    # IceWM format
    print "prog \"$_->{name}\" \"$_->{icon}\" $_->{exec}\n";
}