#!/usr/bin/perl

# Copyright (C) 2012-2017 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/>.

# Original author: dircha
# See: http://bbs.archbang.org/viewtopic.php?id=1589

# Name: obbrowser
# License: GPLv3
# Date: 29 December 2012
# Latest edit: 19 July 2017
# https://github.com/trizen/obbrowser

# ---------------------------------------------------------
# Recursively browse filesystem through openbox3 pipe menus
# ---------------------------------------------------------

use 5.014;
#use strict;
#use warnings;

my $pkgname = 'obbrowser';
my $version = 0.07;

our $CONFIG;

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

my $config_dir  = "$home_dir/.config/obbrowser";
my $config_file = "$config_dir/config.pl";
my $cache_db    = "$config_dir/cache.db";

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

sub print_usage {
    print <<"USAGE";
usage: $0 [dir]

1. To use this script with Openbox, insert the following
   line in ~/.config/openbox/menu.xml:

        <menu id="obbrowser" label="Disk" execute="$0"/>

2. If "obmenu-generator" is used for generating the Openbox menu,
   insert the following line in ~/.config/obmenu-generator/schema.pl:

        {pipe => ["obbrowser", "Disk", "drive-harddisk"]},

3. For more settings, check out the configuration file:

        $config_file

4. After changing the current icon theme, also delete the cache database
   that is generated by obbrowser:

        $cache_db

USAGE
    exit;
}

if (@ARGV and $ARGV[0] eq '-h' || $ARGV[0] eq '--help') {
    print_usage();
}

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

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

=for comment

|| ICON SETTINGS
    | with_icons       : A true value will make the script to use icons for files and directories.
                         This option may be slow, depending on the configuration of your system.

    | mime_ext_only    : A true value will make the script to get the mimetype by extension only.
                         This will improve the performance, as no content will be read from files.

    | icon_size        : Preferred size for icons. (default: 32)
    | skip_svg_icons   : Ignore SVG icons. (default: 0)
    | force_svg_icons  : Use only SVG icons. (default: 0)
    | force_icon_size  : Use only icons at the preferred icon size, if possible. (default: 0)


|| MENU
    | file_manager     : Command to your file manager for opening files and directories.
    | browse_label     : Label for "Browse here..." action.
    | start_path       : An absolute path from which to start to browse the filesystem.
    | dirs_first       : A true value will make the script to order directories before files.

=cut

EOD

my %CONFIG = (
              file_manager    => 'pcmanfm',
              browse_label    => 'Browse here...',
              start_path      => $home_dir,
              dirs_first      => 0,
              with_icons      => 1,
              mime_ext_only   => 0,
              icon_size       => 32,
              force_icon_size => 0,
              force_svg_icons => 0,
              skip_svg_icons  => 0,
              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 -z _) {
    dump_configuration();
}

require $config_file;    # load the configuration file

my @valid_keys = grep exists $CONFIG{$_}, keys %{$CONFIG};
@CONFIG{@valid_keys} = @{$CONFIG}{@valid_keys};

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

{
    @INC{'warnings.pm', 'warnings/register.pm', 'strict.pm'} = ();
}

{
    my %table = (
                 '&' => 'amp',
                 '"' => 'quot',
                 "'" => 'apos',
                 '<' => 'lt',
                 '>' => 'gt',
                );

    sub xmlEscape {
        $_[0] =~ tr/&"'<>// ? $_[0] =~ s/([&"'<>])/&$table{$1};/gr : $_[0];
    }
}

sub escapeQuot {
    index($_[0], '&quot;') == -1 ? $_[0] : $_[0] =~ s/&quot;/\\&quot;/gr;
}

sub mk_dir_elem {
    qq{<menu id="$_[0]/$_[2]" label="}
      . ($_[2] =~ s/_/__/gr)
      . qq{" icon="$_[3]" execute="$_[4] &quot;$_[1]/}
      . escapeQuot($_[2])
      . q{&quot;"/>};
}

sub mk_file_elem {
    qq{<item label="}
      . ($_[2] =~ s/_/__/gr)
      . qq{" icon="$_[3]"><action name="Execute"><execute>$CONFIG{file_manager} &quot;$_[1]/}
      . escapeQuot($_[2])
      . q{&quot;</execute></action></item>};
}

require GDBM_File;
tie my %cache_db, 'GDBM_File', $cache_db, &GDBM_File::GDBM_WRCREAT, 0640;

sub get_icon_path {
    my ($name) = @_;

    state $gtk = do {
        require Gtk2;
        'Gtk2'->init;
        'Gtk2';
    };

    state $theme = do {
        "${gtk}::IconTheme"->get_default;
    };

    state $flags = "${gtk}::IconLookupFlags"->new(
                                                  [($CONFIG{force_icon_size} ? 'force-size' : ()),
                                                   ($CONFIG{skip_svg_icons}  ? 'no-svg'     : ()),
                                                   ($CONFIG{force_svg_icons} ? 'force-svg'  : ()),
                                                  ]
                                                 );

    my $icon_info = $theme->lookup_icon($name, $CONFIG{icon_size}, $flags);

    defined($icon_info)
      ? $icon_info->get_filename
      : '';
}

sub check_icon {
    $cache_db{$_[0]} //= get_icon_path($_[0]);
}

my $path = @ARGV ? shift() : $CONFIG{start_path};

my (%alias, %icons, @dirs, @files);
opendir(my $dir_h, $path) or warn "$0: Can't open dir `$path': $!\n";
foreach my $file (readdir $dir_h) {

    next if chr ord $file eq q{.};    # skip the hidden files

    if ($CONFIG{with_icons}) {

        if (-d "$path/$file") {
            push @dirs, [$file, $icons{'inode-directory'} ||= check_icon('inode-directory')];
            next;
        }

        require File::MimeInfo;       # File::MimeInfo::Magic is better, but slower!

        my $mime_type = (
                         (
                          $CONFIG{mime_ext_only}
                          ? File::MimeInfo::globs($file)
                          : File::MimeInfo::mimetype("$path/$file")
                         ) // 'unknown'
                        ) =~ tr|/|-|r;

        $mime_type = $alias{$mime_type} if exists $alias{$mime_type};

        {
            my $type = $mime_type;
            while (1) {
                if ($icons{$type} ||= check_icon($type)) {
                    $alias{$mime_type} = $type;
                    $mime_type = $type;
                    last;
                }
                elsif ($icons{"gnome-mime-$type"} ||= check_icon("gnome-mime-$type")) {
                    $alias{$mime_type} = "gnome-mime-$type";
                    $mime_type = "gnome-mime-$type";
                    last;
                }
                $type =~ s{.*\K[[:punct:]]\w++$}{} || last;
            }
        }

        if (!$icons{$mime_type}) {
            my $type = $mime_type;
            while (1) {
                $type =~ s{^application-x-\K.*?-}{} || last;
                $icons{$type} ||= check_icon($type);
                $icons{$type} && do { $alias{$mime_type} = $type; $mime_type = $type; last };
            }
        }
        push @files, [
            $file, $icons{$mime_type} ||=
              do { $alias{$mime_type} = 'unknown'; check_icon('unknown') }
        ];
    }
    else {
        push @{-d "$path/$file" ? \@dirs : \@files}, [$file, ''];
    }

}
closedir $dir_h;

my $thisDir            = xmlEscape($path);
my $qEscapedDir        = escapeQuot($thisDir);
my $escapedProgramName = xmlEscape($0);

# "Browse here..." launches this directory
my $generated_menu = qq{<openbox_pipe_menu><item label="$CONFIG{browse_label}"><action name="Execute">}
  . qq{<execute>$CONFIG{file_manager} &quot;$qEscapedDir&quot;</execute></action></item><separator/>};

my @calls = ([\&mk_file_elem => \@files], [\&mk_dir_elem => \@dirs]);

foreach my $call ($CONFIG{dirs_first} ? reverse(@calls) : @calls) {
    $generated_menu .= $call->[0]->($thisDir, $qEscapedDir, xmlEscape($_->[0]), $_->[1], $escapedProgramName)
      for sort { lc $a->[0] cmp lc $b->[0] } @{$call->[1]};
}

local $| = 1;
print $generated_menu, "</openbox_pipe_menu>";
exit;
