#!/usr/bin/perl

# Copyright (C) 2012-2016 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

# License: GPLv3
# Date: 29 December 2012
# Latest edit: 04 May 2016
# Website: http://github.com/trizen/obbrowser

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

#use 5.014;
#use strict;
#use warnings;

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

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 $icons_db_filename = "$config_dir/icons.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 icon database
   that is generated by obbrowser:

        $icons_db_filename

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
    | icon_dirs_first  : While searching for icons, look in this directories first,
                         before looking in the directories of the current icon theme.
                         Example: [
                            "\$ENV{HOME}/My icons",
                         ],

    | icon_dirs_last   : While searching for icons, also look in this icon directories.
                         Example: [
                            "/usr/share/icons/Tango",
                         ],

    | 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.

    | gtk_rc_filename  : Absolute path to the gtkrc file.
                         This file is used to get the name of the current icon theme.


|| 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 = (
              'Linux::DesktopFiles' => {
                                        gtk_rc_filename => "$home_dir/.gtkrc-2.0",
                                        icon_dirs_first => undef,
                                        icon_dirs_last  => undef,
                                        skip_svg_icons  => 0,
                                       },
              file_manager  => 'pcmanfm',
              browse_label  => 'Browse here...',
              start_path    => $home_dir,
              dirs_first    => 0,
              with_icons    => 1,
              mime_ext_only => 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();
}

my $ld_obj;
if ($CONFIG{with_icons}) {

    my @keys = qw(
      Tie/Hash.pm
      Carp.pm
      Exporter.pm
      warnings.pm
      );

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

    require Linux::DesktopFiles;

    $Linux::DesktopFiles::VERSION >= 0.08
      || die "Update Linux::DesktopFiles to a newer version! (requires >=0.08)\n";

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

        strict_icon_dirs        => 1,
        use_current_theme_icons => 1,
        home_dir                => $home_dir,

        $CONFIG{with_icons}
        ? (
           abs_icon_paths   => 1,
           icon_db_filename => $icons_db_filename,
          )
        : (),
    );

    delete @INC{@keys};
}

{
    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>};
}

{
    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'} ||= $ld_obj->get_icon_path('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} ||= $ld_obj->get_icon_path($type)) {
                        $alias{$mime_type} = $type;
                        $mime_type = $type;
                        last;
                    }
                    elsif ($icons{"gnome-mime-$type"} ||= $ld_obj->get_icon_path("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} ||= $ld_obj->get_icon_path($type);
                    $icons{$type} && do { $alias{$mime_type} = $type; $mime_type = $type; last };
                }
            }
            push @files, [
                $file, $icons{$mime_type} ||=
                  do { $alias{$mime_type} = 'unknown'; $ld_obj->get_icon_path('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]};
    }

    ++$|;
    print $generated_menu, "</openbox_pipe_menu>";
    exit;
}
