· 8 years ago · Mar 11, 2018, 01:24 PM
1#!/usr/bin/perl
2
3# Copyright (C) 2012-2016 Daniel "Trizen" Șuteu <echo dHJpemVueEBnbWFpbC5jb20K | base64 -d>.
4#
5# This program is free software: you can redistribute it and/or modify
6# it under the terms of the GNU General Public License as published by
7# the Free Software Foundation, either version 3 of the License, or
8# (at your option) any later version.
9#
10# This program is distributed in the hope that it will be useful,
11# but WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13# GNU General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License
16# along with this program. If not, see <http://www.gnu.org/licenses/>.
17
18# Original author: dircha
19# See: http://bbs.archbang.org/viewtopic.php?id=1589
20
21# License: GPLv3
22# Date: 29 December 2012
23# Latest edit: 04 May 2016
24# Website: http://github.com/trizen/obbrowser
25
26# ---------------------------------------------------------
27# Recursively browse filesystem through openbox3 pipe menus
28# ---------------------------------------------------------
29
30#use 5.014;
31#use strict;
32#use warnings;
33
34my $pkgname = 'obbrowser';
35my $version = 0.06;
36
37our $CONFIG;
38
39my $home_dir =
40 $ENV{HOME}
41 || $ENV{LOGDIR}
42 || (getpwuid($<))[7]
43 || `echo -n ~`;
44
45my $config_dir = "$home_dir/.config/obbrowser";
46my $config_file = "$config_dir/config.pl";
47my $icons_db_filename = "$config_dir/icons.db";
48
49if (not -d $config_dir) {
50 require File::Path;
51 File::Path::make_path($config_dir)
52 or die "Can't create dir `$config_dir': $!";
53}
54
55sub print_usage {
56 print <<"USAGE";
57usage: $0 [dir]
58
591. To use this script with Openbox, insert the following
60 line in ~/.config/openbox/menu.xml:
61
62 <menu id="obbrowser" label="Disk" execute="$0"/>
63
642. If "obmenu-generator" is used for generating the Openbox menu,
65 insert the following line in ~/.config/obmenu-generator/schema.pl:
66
67 {pipe => ["obbrowser", "Disk", "drive-harddisk"]},
68
693. For more settings, check out the configuration file:
70
71 $config_file
72
734. After changing the current icon theme, also delete the icon database
74 that is generated by obbrowser:
75
76 $icons_db_filename
77
78USAGE
79 exit;
80}
81
82if (@ARGV and $ARGV[0] eq '-h' || $ARGV[0] eq '--help') {
83 print_usage();
84}
85
86my $config_documentation = <<"EOD";
87#!/usr/bin/perl
88
89# $pkgname - configuration file
90# This file is updated automatically.
91# Any additional comment and/or indentation will be lost.
92
93=for comment
94
95|| ICON SETTINGS
96 | icon_dirs_first : While searching for icons, look in this directories first,
97 before looking in the directories of the current icon theme.
98 Example: [
99 "\$ENV{HOME}/My icons",
100 ],
101
102 | icon_dirs_last : While searching for icons, also look in this icon directories.
103 Example: [
104 "/usr/share/icons/Tango",
105 ],
106
107 | with_icons : A true value will make the script to use icons for files and directories.
108 This option may be slow, depending on the configuration of your system.
109
110 | mime_ext_only : A true value will make the script to get the mimetype by extension only.
111 This will improve the performance, as no content will be read from files.
112
113 | gtk_rc_filename : Absolute path to the gtkrc file.
114 This file is used to get the name of the current icon theme.
115
116
117|| MENU
118 | file_manager : Command to your file manager for opening files and directories.
119 | browse_label : Label for browse here action.
120 | start_path : An absolute path from which to start to browse the filesystem.
121 | dirs_first : A true value will make the script to order directories before files.
122
123=cut
124
125EOD
126
127my %CONFIG = (
128 'Linux::DesktopFiles' => {
129 gtk_rc_filename => "$home_dir/.gtkrc-2.0",
130 icon_dirs_first => undef,
131 icon_dirs_last => undef,
132 skip_svg_icons => 0,
133 },
134 file_manager => 'pcmanfm',
135 browse_label => 'Browse here...',
136 start_path => $home_dir,
137 dirs_first => 0,
138 with_icons => 1,
139 mime_ext_only => 0,
140 VERSION => $version,
141 );
142
143sub dump_configuration {
144 require Data::Dump;
145 open my $config_fh, '>', $config_file
146 or die "Can't open file '${config_file}' for write: $!";
147 my $dumped_config = q{our $CONFIG = } . Data::Dump::dump(\%CONFIG);
148 print $config_fh $config_documentation, $dumped_config;
149 close $config_fh;
150}
151
152if (not -e $config_file or -z _) {
153 dump_configuration();
154}
155
156require $config_file; # load the configuration file
157
158my @valid_keys = grep exists $CONFIG{$_}, keys %{$CONFIG};
159@CONFIG{@valid_keys} = @{$CONFIG}{@valid_keys};
160
161if ($CONFIG{VERSION} != $version) {
162 $CONFIG{VERSION} = $version;
163 dump_configuration();
164}
165
166my $ld_obj;
167if ($CONFIG{with_icons}) {
168
169 my @keys = qw(
170 Tie/Hash.pm
171 Carp.pm
172 Exporter.pm
173 warnings.pm
174 );
175
176 @INC{@keys, 'warnings/register.pm', 'strict.pm'} = ();
177
178 require Linux::DesktopFiles;
179
180 $Linux::DesktopFiles::VERSION >= 0.08
181 || die "Update Linux::DesktopFiles to a newer version! (requires >=0.08)\n";
182
183 $ld_obj = Linux::DesktopFiles->new(
184 %{$CONFIG{'Linux::DesktopFiles'}},
185
186 strict_icon_dirs => 1,
187 use_current_theme_icons => 1,
188 home_dir => $home_dir,
189
190 $CONFIG{with_icons}
191 ? (
192 abs_icon_paths => 1,
193 icon_db_filename => $icons_db_filename,
194 )
195 : (),
196 );
197
198 delete @INC{@keys};
199}
200
201{
202 my %table = (
203 '&' => 'amp',
204 '"' => 'quot',
205 "'" => 'apos',
206 '<' => 'lt',
207 '>' => 'gt',
208 );
209
210 sub xmlEscape {
211 $_[0] =~ tr/&"'<>// ? $_[0] =~ s/([&"'<>])/&$table{$1};/gr : $_[0];
212 }
213}
214
215sub escapeQuot {
216 index($_[0], '"') == -1 ? $_[0] : $_[0] =~ s/"/\\"/gr;
217}
218
219sub mk_dir_elem {
220 qq{<menu id="$_[0]/$_[2]" label="}
221 . ($_[2] =~ s/_/__/gr)
222 . qq{" icon="$_[3]" execute="$_[4] "$_[1]/}
223 . escapeQuot($_[2])
224 . q{""/>};
225}
226
227sub mk_file_elem {
228 qq{<item label="}
229 . ($_[2] =~ s/_/__/gr)
230 . qq{" icon="$_[3]"><action name="Execute"><execute>$CONFIG{file_manager} "$_[1]/}
231 . escapeQuot($_[2])
232 . q{"</execute></action></item>};
233}
234
235{
236 my $path = @ARGV ? shift() : $CONFIG{start_path};
237
238 my (%alias, %icons, @dirs, @files);
239 opendir(my $dir_h, $path) or warn "$0: Can't open dir `$path': $!\n";
240 foreach my $file (readdir $dir_h) {
241
242 next if chr ord $file eq q{.}; # skip the hidden files
243
244 if ($CONFIG{with_icons}) {
245
246 if (-d "$path/$file") {
247 push @dirs, [$file, $icons{'inode-directory'} ||= $ld_obj->get_icon_path('inode-directory')];
248 next;
249 }
250
251 require File::MimeInfo; # File::MimeInfo::Magic is better, but slower!
252
253 my $mime_type = (
254 (
255 $CONFIG{mime_ext_only}
256 ? File::MimeInfo::globs($file)
257 : File::MimeInfo::mimetype("$path/$file")
258 ) // 'unknown'
259 ) =~ tr{/}{-}r;
260
261 $mime_type = $alias{$mime_type} if exists $alias{$mime_type};
262
263 {
264 my $type = $mime_type;
265 while (1) {
266 if ($icons{$type} ||= $ld_obj->get_icon_path($type)) {
267 $alias{$mime_type} = $type;
268 $mime_type = $type;
269 last;
270 }
271 elsif ($icons{"gnome-mime-$type"} ||= $ld_obj->get_icon_path("gnome-mime-$type")) {
272 $alias{$mime_type} = "gnome-mime-$type";
273 $mime_type = "gnome-mime-$type";
274 last;
275 }
276 $type =~ s{.*\K[[:punct:]]\w++$}{} || last;
277 }
278 }
279
280 if (!$icons{$mime_type}) {
281 my $type = $mime_type;
282 while (1) {
283 $type =~ s{^application-x-\K.*?-}{} || last;
284 $icons{$type} ||= $ld_obj->get_icon_path($type);
285 $icons{$type} && do { $alias{$mime_type} = $type; $mime_type = $type; last };
286 }
287 }
288 push @files, [
289 $file, $icons{$mime_type} ||=
290 do { $alias{$mime_type} = 'unknown'; $ld_obj->get_icon_path('unknown') }
291 ];
292 }
293 else {
294 push @{-d "$path/$file" ? \@dirs : \@files}, [$file, ''];
295 }
296
297 }
298 closedir $dir_h;
299
300 my $thisDir = xmlEscape($path);
301 my $qEscapedDir = escapeQuot($thisDir);
302 my $escapedProgramName = xmlEscape($0);
303
304 # "Browse here..." launches this directory
305 my $generated_menu = qq{<openbox_pipe_menu><item label="$CONFIG{browse_label}"><action name="Execute">}
306 . qq{<execute>$CONFIG{file_manager} "$qEscapedDir"</execute></action></item><separator/>};
307
308 my @calls = ([\&mk_file_elem => \@files], [\&mk_dir_elem => \@dirs]);
309
310 foreach my $call ($CONFIG{dirs_first} ? reverse(@calls) : @calls) {
311 $generated_menu .= $call->[0]->($thisDir, $qEscapedDir, xmlEscape($_->[0]), $_->[1], $escapedProgramName)
312 for sort { lc $a->[0] cmp lc $b->[0] } @{$call->[1]};
313 }
314
315 ++$|;
316 print $generated_menu, "</openbox_pipe_menu>";
317 exit;
318}