Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/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], '"') == -1 ? $_[0] : $_[0] =~ s/"/\\"/gr;
- }
- sub mk_dir_elem {
- qq{<menu id="$_[0]/$_[2]" label="}
- . ($_[2] =~ s/_/__/gr)
- . qq{" icon="$_[3]" execute="$_[4] "$_[1]/}
- . escapeQuot($_[2])
- . q{""/>};
- }
- sub mk_file_elem {
- qq{<item label="}
- . ($_[2] =~ s/_/__/gr)
- . qq{" icon="$_[3]"><action name="Execute"><execute>$CONFIG{file_manager} "$_[1]/}
- . escapeQuot($_[2])
- . q{"</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} "$qEscapedDir"</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;
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement