#!/usr/bin/perl

# Copyright (C) 2011-2013 Daniel "Trizen" Șuteu <echo dHJpemVueEBnbWFpbC5jb20K | base64 -d>.
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

# Fluxbox Menu Generator
# A simple menu generator for the Fluxbox Window Manager
# Should be installed in $PATH before the first execution!

# License: GPLv3
# Created on: 01 August 2010
# Latest edit on: 03 October 2013
# Website: http://trizen.googlecode.com

use 5.014;
use Linux::DesktopFiles 0.08;

my $pkgname = 'fbmenugen';
my $version = '0.75';

my ($icons, $pipe, $reconfigure, $update_config, $stdout_config);

our ($CONFIG, $SCHEMA);

my $home_dir =
     $ENV{HOME}
  || $ENV{LOGDIR}
  || (getpwuid($<))[7]
  || `echo -n ~`;

my $xdg_config_home = $ENV{XDG_CONFIG_HOME} || "$home_dir/.config";

my $config_dir  = "$xdg_config_home/$pkgname";
my $schema_file = "$config_dir/schema.pl";
my $config_file = "$config_dir/config.pl";
my $icons_db    = "$config_dir/icons.db";
my $fluxbox_dir = "$home_dir/.fluxbox";
my $menufile    = "$fluxbox_dir/menu";

sub usage {
    print <<"HELP";
usage: $0 [options]

Options :
    -i  : use icons in menus
    -d  : regenerate icons.db (with -i)
    -p  : pipe menu (prints to the STDOUT)
    -o  : menu file (default: ~/.fluxbox/menu)
    -u  : update the config file
    -r  : regenerate the config files

Help:
    -h  : print this message
    -v  : print the version number
    -S  : print the schema file to STDOUT
    -H  : print help message for config files

Example:
    ** Generate a simple menu
        $0

    ** Generate a menu with icons
        $0 -i

** Config file: $config_file
** Schema file: $schema_file
HELP
    exit 0;
}

my $config_help = <<"HELP";

|| FILTERING
    | skip_filename_re    : Skip a .desktop file if its name matches the regex.
                            Name is from the last slash to the end. (filename.desktop)
                            Example: qr/^(?:gimp|xterm)\\b/,    # skips 'gimp' and 'xterm'

    | skip_entry          : Skip a destkop file if the value from a given key matches the regex.
                            Example: [
                                {key => 'Name', re => qr/(?:about|terminal)/i},
                                {key => 'Exec', re => qr/^xterm/},
                            ],

    | substitutions       : Substitute, by using a regex, in the values of the desktop files.
                            Example: [
                                {key => 'Exec', re => qr/xterm/, value => 'sakura'},
                                {key => 'Exec', re => qr/\\\\\\\\/,  value => '\\\\', global => 1},    # for wine apps
                            ],


|| ICON SETTINGS
    | icon_dirs_first     : When looking for icons, look in this directories first,
                            before looking in the directories of the current icon theme.
                            Example: [
                                "\$ENV{HOME}/My icons",
                            ],

    | icon_dirs_second    : Look in this directories after looked in the directories of the
                            current icons theme. (Before /usr/share/pixmaps)
                            Example: [
                                "/usr/share/icons/gnome",
                            ],

    | icon_dirs_last      : Look in this directories at the very last, after looked in
                            /usr/share/pixmaps, /usr/share/icons/hicolor and some other
                            directories.
                            Example: [
                                "/usr/share/icons/Tango",
                            ],

    | strict_icon_dirs    : A true value will make the module to look only inside the directories
                            specified by you in either one of the above tree options.

    | gtk_rc_filename     : Absolute path to the GTK configuration file.
    | missing_image       : Use this icon for a missing icons (default: gtk-missing-image)


|| KEYS
    | tooltip_keys        : Valid keys for the tooltip text.
                            Example: ['Comment[es]', 'Comment'],

    | name_keys           : Valid keys for the item names.
                            Example: ['Name[fr]', 'GenericName[fr]', 'Name'],   # french menu


|| PATHS
    | desktop_files_paths   : Absolute paths which contains .desktop files.
                              Example: [
                                '/usr/share/applications',
                                "\$ENV{HOME}/.local/share/applications",
                                glob("\$ENV{HOME}/.local/share/applications/wine/Programs/*"),
                              ],


|| NOTES
    | Regular expressions:
        * use qr/RE/ instead of 'RE'
        * use qr/RE/i for case insenstive mode
HELP

my $schema_help = <<"HELP";

item: add an item into the menu

    {item => ["command", "label", "icon"]}


cat: add a category into the menu

    {cat => ["name", "label", "icon"]}


begin_cat: begin of a category

    {begin_cat => ["name", "icon"]}


end_cat: end of a category

    {end_cat => undef}


sep: horizontal line separator

    {sep => undef}


exit: default "Exit" action

    {exit => ["label", "icon"]}


raw: any valid fluxbox menu entry

    {raw => q(...)},
    {raw => q([exec] (Geeqie) {geeqie -r } </usr/share/pixmaps/geeqie.png>)},


fbmenugen: category provided by $pkgname

    {fbmenugen => ["label", "icon"]}


fluxbox: the default fluxbox config menu

    {fluxbox => ["label", "icon"]}
HELP

sub full_help {
    print <<"HELP";
=>> Schema file:
$schema_help
====================================================

=>> Config file:
$config_help
HELP

    exit 0;
}

if (@ARGV) {
    while (defined(my $arg = shift @ARGV)) {
        if ($arg eq '-i') {
            $icons = 1;
        }
        elsif ($arg eq '-S') {
            $stdout_config = 1;
        }
        elsif ($arg eq '-r') {
            $reconfigure = 1;
        }
        elsif ($arg eq '-p') {
            $pipe = 1;
        }
        elsif ($arg eq '-d') {
            unlink $icons_db;
        }
        elsif ($arg eq '-u') {
            $update_config = 1;
        }
        elsif ($arg eq '-v') {
            print "$pkgname $version\n";
            exit;
        }
        elsif ($arg eq '-o') {
            $menufile = shift(@ARGV) // die "$0: option '-o' requires an argument!\n";
        }
        elsif ($arg eq '-h') {
            usage();
        }
        elsif ($arg eq '-H') {
            full_help();
        }
    }
}

if (not -d $config_dir) {
    require File::Path;
    File::Path::make_path($config_dir)
      or die "Can't create directory '${config_dir}': $!";
}

my $config_documentation = <<"EOD";
#!/usr/bin/perl

# $pkgname - configuration file
# This file will be updated automatically every time when is needed.
# Any additional comment and/or indentation will be lost.

=for comment
$config_help
=cut

EOD

my %CONFIG = (
    'Linux::DesktopFiles' => {

        keep_unknown_categories => 1,
        unknown_category_key    => 'other',
        gtk_rc_filename         => "$home_dir/.gtkrc-2.0",

        skip_entry       => undef,
        substitutions    => undef,
        skip_filename_re => undef,

        terminalize            => 1,
        terminalization_format => q{%s -e '%s'},

        desktop_files_paths => ['/usr/share/applications'],

        icon_dirs_first  => undef,
        icon_dirs_second => undef,
        icon_dirs_last   => undef,
        strict_icon_dirs => undef,

        skip_svg_icons => 1,
    },

    name_keys    => ['Name'],
    menu_title   => 'INARYLinux',
    terminal     => 'lxterminal',
    editor       => 'leafpad',
    missing_icon => 'gtk-missing-image',
    VERSION      => $version,
             );

sub dump_configuration {
    require Data::Dump;
    open my $config_fh, '>', $config_file
      or die "Can't open file '${config_file}' for write: $!";
    my $dumped_config = q{our $CONFIG = } . Data::Dump::dump(\%CONFIG);
    print $config_fh $config_documentation, $dumped_config;
    close $config_fh;
}

if (not -e $config_file or $reconfigure) {
    dump_configuration();
}

if (not -e $schema_file or $reconfigure or $stdout_config) {

    my $schema_fh = $stdout_config ? \*STDOUT : do {
        open my $fh, '>', $schema_file
          or die "Can't open file '${schema_file}' for write: $!";
        $fh;
    };

    print $schema_fh <<"SCHEMA_FILE";
#!/usr/bin/perl

# $pkgname - schema file

=for comment
$schema_help
=cut

# NOTE:
#    * Keys and values are case sensitive. Keep all keys lowercase.
#    * ICON can be a either a direct path to an icon or a valid icon name
#    * Category names are case insensitive. (X-XFCE and x_xfce are equivalent)

require '${config_file}';

our \$SCHEMA = [
    #          COMMAND             LABEL                ICON
    {item => ['pcmanfm',       'File Manager',      'file-manager']},
    {item => ['lxterminal',    'Terminal',          'terminal']},
    {item => ['leafpad',       'Editor',            'leafpad']},
    {item => ['firefox',       'Web Browser',       'web-browser']},
    {item => ['fbrun',         'Run command',       'system-run']},

    {sep => 'undef'},

    #          NAME            LABEL                ICON
    {cat => ['utility',     'Accessories', 'applications-utilities']},
    {cat => ['development', 'Development', 'applications-development']},
    {cat => ['education',   'Education',   'applications-science']},
    {cat => ['game',        'Games',       'applications-games']},
    {cat => ['graphics',    'Graphics',    'applications-graphics']},
    {cat => ['audiovideo',  'Multimedia',  'applications-multimedia']},
    {cat => ['network',     'Network',     'applications-internet']},
    {cat => ['office',      'Office',      'applications-office']},
    {cat => ['other',       'Other',       'applications-other']},
    {cat => ['settings',    'Settings',    'applications-accessories']},
    {cat => ['system',      'System',      'applications-system']},

    #{cat => ['qt',          'QT Applications',    'qtlogo']},
    #{cat => ['gtk',         'GTK Applications',   'gnome-applications']},
    #{cat => ['x_xfce',      'XFCE Applications',  'applications-other']},
    #{cat => ['gnome',       'GNOME Applications', 'gnome-applications']},
    #{cat => ['consoleonly', 'CLI Applications',   'applications-utilities']},

    #                  LABEL          ICON
    #{begin_cat => ['My category',  'cat-icon']},
    #             ... some items ...
    #{end_cat   => undef},

    #                  LABEL               ICON
    {fbmenugen  => ['FBMenuConf',   'preferences-desktop']},
    {fluxbox    => ['Fluxbox menu', 'package_settings']},
    {sep        => undef},
    {regenerate => ['Regenerate',     'gtk-refresh']},

    # This options uses the default Fluxbox action "Exit"
    {exit       => ['Logout',           'exit']},
    {item => ['oblogout', 'Exit', 'exit']},
]
SCHEMA_FILE

    close $schema_fh;
}

require $schema_file;    # Load the configuration files

# Remove user's defined values
my @valid_keys = grep exists $CONFIG{$_}, keys $CONFIG;
@CONFIG{@valid_keys} = @{$CONFIG}{@valid_keys};

# Keep user's defined values
#@CONFIG{keys %{$CONFIG}} = values %{$CONFIG};

if ($CONFIG{VERSION} != $version) {
    $update_config = 1;
    $CONFIG{VERSION} = $version;
}

my $desk_obj = Linux::DesktopFiles->new(
    %{$CONFIG{'Linux::DesktopFiles'}},

    home_dir => $home_dir,

    categories => [map $_->{cat}[0], grep exists $_->{cat}, @$SCHEMA],
    keys_to_keep => [@{$CONFIG{name_keys}}, 'Exec', $icons ? 'Icon' : ()],

    $icons
    ? (
       abs_icon_paths   => 1,
       icon_db_filename => $icons_db,
      )
    : (),

    terminal              => $CONFIG{terminal},
    keep_empty_categories => 0,
    case_insensitive_cats => 1,
                                       );

my $generated_menu = <<"HEADER";
#
## File generated by $pkgname v$version
#

[begin] ($CONFIG{menu_title})
[encoding] {UTF-8}
HEADER

{
    my $menu_backup = $menufile . '.bak';
    if (not -e $menu_backup and -e $menufile) {
        require File::Copy;
        File::Copy::copy($menufile, $menu_backup);
    }
}

sub check_icon {
    defined($_[0]) && (chr ord($_[0]) eq '/') ? $_[0] : $desk_obj->get_icon_path($_[0])
      || $desk_obj->get_icon_path($CONFIG{missing_icon});
}

sub prepare_item {
    my $command = shift() =~ s/\}/\\}/gr;
    my $name    = shift() =~ s/\)/\\)/gr;
    my $icon    = shift();

    $icons
      ? <<"ITEM_WITH_ICON"
  [exec] ($name) {$command} <${\check_icon($icon)}>
ITEM_WITH_ICON
      : <<"ITEM";
  [exec] ($name) {$command}
ITEM
}

sub begin_category {
    $icons
      ? <<"MENU_WITH_ICON"
[submenu] ($_[0]) <${\check_icon($_[1])}>
MENU_WITH_ICON
      : <<"MENU"
[submenu] ($_[0])
MENU
}

my $categories = $desk_obj->parse_desktop_files();

foreach my $schema (@$SCHEMA) {
    if (exists $schema->{cat}) {
        exists($categories->{my $category = lc($schema->{cat}[0]) =~ tr/_a-z0-9/_/cr}) || next;
        $generated_menu .= begin_category($schema->{cat}[1], ($icons ? $schema->{cat}[2] : ())) . join(
            q{},
            (
             map $_->[1],
             sort { $a->[0] cmp $b->[0] }
               map [lc($_) => $_],
             map {
                 my $name;
                 my $exec = $_->{Exec};

                 foreach my $key (@{$CONFIG{name_keys}}) {
                     if (defined $_->{$key}) {
                         $name = $_->{$key};
                         last;
                     }
                 }

                 prepare_item($exec, $name, $icons ? $_->{Icon} : ());
               } @{$categories->{$category}}
            )
          )
          . "[end]\n";
    }
    elsif (exists $schema->{item}) {
        $generated_menu .= prepare_item(@{$schema->{item}});
    }
    elsif (exists $schema->{sep}) {
        $generated_menu .= "[separator]\n";
    }
    elsif (exists $schema->{begin_cat}) {
        $generated_menu .= begin_category(@{$schema->{begin_cat}});
    }
    elsif (exists $schema->{end_cat}) {
        $generated_menu .= "[end]\n";
    }
    elsif (exists $schema->{raw}) {
        $generated_menu .= "$schema->{raw}\n";
    }
    elsif (exists $schema->{fbmenugen}) {
        $generated_menu .= begin_category(@{$schema->{fbmenugen}});
        foreach my $item (
                          ["$CONFIG{editor} $menufile",    'Open the menu file'],
                          ["$CONFIG{editor} $config_file", 'Open the config file'],
                          ["$CONFIG{editor} $schema_file", 'Open the schema file'],
          ) {
            $generated_menu .= prepare_item(@$item, $schema->{fbmenugen}[1]);
        }
        $generated_menu .= "[end]\n";
    }
    elsif (exists $schema->{exit}) {
        my ($name, $icon) = @{$schema->{exit}};
        $generated_menu .= $icons
          ? <<EXIT_WITH_ICON
[exit] ($name) <${\check_icon($icon)}>
EXIT_WITH_ICON
          : <<EXIT;
[exit] ($name)
EXIT
    }
    elsif (exists $schema->{regenerate}) {
        require Cwd;
        my $regenerate_exec = join(q{ }, $^X, quotemeta(Cwd::abs_path($0)), $icons ? '-i' : '');

        my ($label, $icon) = @{$schema->{regenerate}};
        $generated_menu .= prepare_item($regenerate_exec, $label, $icon);
    }
    elsif (exists $schema->{fluxbox}) {
        my ($label, $icon) =
          ref $schema->{fluxbox} eq 'ARRAY'
          ? @{$schema->{fluxbox}}
          : $schema->{fluxbox};

        $generated_menu .= begin_category(@{$schema->{fluxbox}}) . <<"FOOTER";
[config] (Configure)
[submenu] (System Styles) {Choose a style...}
  [stylesdir] (/usr/share/fluxbox/styles)
[end]
[submenu] (User Styles) {Choose a style...}
  [stylesdir] (~/.fluxbox/styles)
[end]
[workspaces] (Workspace List)
[submenu] (Tools)
  [exec] (Screenshot - JPG) {import screenshot.jpg && display -resize 50% screenshot.jpg}
  [exec] (Screenshot - PNG) {import screenshot.png && display -resize 50% screenshot.png}
  [exec] (Run) {fbrun}
  [exec] (Regen Menu) {fluxbox-generate_menu}
[end]
[submenu] (Window Managers)
  [restart] (openbox) {openbox}
[end]
[commanddialog] (Fluxbox Command)
  [reconfig] (Reload config)
  [restart] (Restart)
  [exec] (About) {(fluxbox -v; fluxbox -info | sed 1d) | xmessage -file - -center}
  [separator]
  [exit] (Exit)
[end]
FOOTER
    }
}

$generated_menu .= "\n[endencoding]\n[end]\n";

my $out_fh = $pipe ? \*STDOUT : do {
    open my $fh, '>', $menufile
      or die "Can't open '${menufile}' for write: $!";
    $fh;
};

print $out_fh $generated_menu;
dump_configuration() if $update_config;