1#!
2#-------------------------------------------------------------------------------
3# cmd-util.pl
4#
5# Copyright (C) 2007-2008,2010,2012,2014,2019 Oliver Hamann.
6#
7# Homepage: http://eaglemode.sourceforge.net/
8#
9# This program is free software: you can redistribute it and/or modify it under
10# the terms of the GNU General Public License version 3 as published by the
11# Free Software Foundation.
12#
13# This program is distributed in the hope that it will be useful, but WITHOUT
14# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
15# FOR A PARTICULAR PURPOSE. See the GNU General Public License version 3 for
16# more details.
17#
18# You should have received a copy of the GNU General Public License version 3
19# along with this program. If not, see <http://www.gnu.org/licenses/>.
20#-------------------------------------------------------------------------------
21
22use strict;
23use warnings;
24use Config;
25use File::Basename;
26use File::Spec::Functions;
27use IO::Handle;
28# Hint: never 'use File::stat' here, otherwise we would have to adapt all the
29# command scripts which use the normal stat function.
30
31
32#================================ Configuration ================================
33
34# Whether to run sync at the end of commands. Can be overloaded with the
35# environment variable EM_FM_SYNC.
36my $Sync='no';
37if (exists($ENV{'EM_FM_SYNC'})) { $Sync=$ENV{'EM_FM_SYNC'}; }
38
39# Terminal colors.
40my $TermBg   ='#aaaaaa';
41my $TermFg   ='#000000';
42my $TCNormal ="\e[0m";
43my $TCInfo   ="\e[0;34m";
44my $TCSuccess="\e[1;32m";
45my $TCError  ="\e[1;31m";
46my $TCClose  ="\e[1;37m";
47
48
49#======================= Parse arguments / private stuff =======================
50
51if ($Config{'osname'} eq 'MSWin32') {
52	Error("The file manager commands do not function on Windows.");
53}
54
55my $Pass;
56my $FirstPassResult;
57my @Src;
58my @Tgt;
59
60{
61	my $i=0;
62	if ($ARGV[$i] eq "pass2") {
63		$Pass=2;
64		$FirstPassResult=$ARGV[$i+1];
65		$i+=2;
66		if (exists($ENV{'EM_SAVED_LD_LIBRARY_PATH'})) {
67			$ENV{'LD_LIBRARY_PATH'}=$ENV{'EM_SAVED_LD_LIBRARY_PATH'};
68			delete($ENV{'EM_SAVED_LD_LIBRARY_PATH'});
69		}
70	}
71	else {
72		$Pass=1;
73		$FirstPassResult="";
74	}
75	if (@ARGV < $i+2) { die "bad arguments"; }
76	my $srcCnt=$ARGV[$i++];
77	my $tgtCnt=$ARGV[$i++];
78	if (@ARGV != $i+$srcCnt+$tgtCnt) { die "bad arguments"; }
79	@Src=@ARGV[$i..($i+$srcCnt-1)];
80	$i+=$srcCnt;
81	@Tgt=@ARGV[$i..($i+$tgtCnt-1)];
82}
83
84
85#============================== First/second pass ==============================
86
87sub SecondPassInTerminal
88	# Restart the whole command script in a terminal.
89	# This function does not return.
90	# Arguments: <title> [, "-hold"]
91	# The argument "-hold" is useful for debugging: the terminal does not
92	# close on exit.
93{
94	my $x=int($ENV{'EM_X'}+($ENV{'EM_WIDTH'}-510)/2);
95	my $y=int($ENV{'EM_Y'}+($ENV{'EM_HEIGHT'}-350)/2);
96	if ($x < 0) { $x=0; }
97	if ($y < 0) { $y=0; }
98	if (exists($ENV{'LD_LIBRARY_PATH'})) {
99		$ENV{'EM_SAVED_LD_LIBRARY_PATH'}=$ENV{'LD_LIBRARY_PATH'};
100		# Because LD_LIBRARY_PATH is cleared through xterm on some systems.
101	}
102	ExecOrError(
103		'xterm',
104		'-sb',
105		'-sl','1000', # don't make this too large (slows down)
106		'-bg',$TermBg,
107		'-fg',$TermFg,
108		'-geometry',"80x24+${x}+${y}",
109		'-T',@_,
110		'-e',
111		'perl',
112		$0,
113		'pass2',
114		$FirstPassResult,
115		($#Src)+1,
116		($#Tgt)+1,
117		@Src,
118		@Tgt
119	);
120}
121
122
123sub IsFirstPass
124	# Returns non-zero if the script has not yet been restarted for the
125	# second pass.
126{
127	return $Pass == 1;
128}
129
130
131sub SetFirstPassResult
132	# Set a single scalar value (no reference), which can be re-get in the
133	# second pass.
134{
135	$FirstPassResult=$_[0];
136}
137
138
139sub GetFirstPassResult
140	# Get the value set with SetFirstPassResult.
141{
142	return $FirstPassResult;
143}
144
145
146#============================= Get the selections ==============================
147
148sub GetSrc
149	# Get list of source-selected files.
150{
151	return @Src;
152}
153
154
155sub GetTgt
156	# Get list of target-selected files.
157{
158	return @Tgt;
159}
160
161
162sub GetSrcListing
163	# Get a string containing a listing of source-selected files, each on a
164	# separate line, with some indent.
165{
166	my $l="";
167	for (my $i=0; $i<@Src; $i++) {
168		$l .= "  " . $Src[$i] . "\n";
169	}
170	return $l;
171}
172
173
174sub GetTgtListing
175	# Get a string containing a listing of target-selected files, each on a
176	# separate line, with some indent.
177{
178	my $l="";
179	for (my $i=0; $i<@Tgt; $i++) {
180		$l .= "  " . $Tgt[$i] . "\n";
181	}
182	return $l;
183}
184
185#=============================== General Helpers ===============================
186
187sub CheckFilename
188{
189	my $name=shift;
190
191	if ($name =~ /\//) {
192		Error("File names must not contain slashes.");
193	}
194	if ($name =~ /^\.?\.?$/) {
195		Error("File names must not be empty or consist of just one or two periods.");
196	}
197}
198
199#======================== Sending commands to eaglemode ========================
200
201sub SendUpdate
202	# Require Eagle Mode to reload changed files and directories.
203{
204	system(
205		catfile($ENV{'EM_DIR'},"bin","emSendMiniIpc"),
206		$ENV{'EM_FM_SERVER_NAME'},
207		"update"
208	);
209}
210
211
212sub SendSelect
213	# Require Eagle Mode to select other targets. It will even reload
214	# changed files and directories. As usual, the source selection is set
215	# from the old target selection.
216	# Arguments: <file>, [<file>...]
217{
218	system(
219		catfile($ENV{'EM_DIR'},"bin","emSendMiniIpc"),
220		$ENV{'EM_FM_SERVER_NAME'},
221		"select",
222		$ENV{'EM_COMMAND_RUN_ID'},
223		@_
224	);
225}
226
227
228sub SendSelectKS
229	# Like SendSelect, but the source selection is not modified.
230{
231	system(
232		catfile($ENV{'EM_DIR'},"bin","emSendMiniIpc"),
233		$ENV{'EM_FM_SERVER_NAME'},
234		"selectks",
235		$ENV{'EM_COMMAND_RUN_ID'},
236		@_
237	);
238}
239
240
241sub SendSelectCS
242	# Like SendSelect, but the source selection is cleared.
243{
244	system(
245		catfile($ENV{'EM_DIR'},"bin","emSendMiniIpc"),
246		$ENV{'EM_FM_SERVER_NAME'},
247		"selectcs",
248		$ENV{'EM_COMMAND_RUN_ID'},
249		@_
250	);
251}
252
253
254#================================ Basic dialogs ================================
255
256sub Dlg
257	# Low-level function for calling emShowStdDlg.
258{
259	my $p=catfile($ENV{'EM_DIR'},"bin","emShowStdDlg");
260
261	my $w=400;
262	my $h=300;
263	my $x=int($ENV{'EM_X'}+($ENV{'EM_WIDTH'}-$w)/2);
264	my $y=int($ENV{'EM_Y'}+($ENV{'EM_HEIGHT'}-$h)/2);
265	if ($x < 0) { $x=0; }
266	if ($y < 0) { $y=0; }
267	my $g="${w}x${h}+${x}+${y}";
268
269	my $e=system($p,'-geometry',$g,@_);
270	if ($e==-1) {
271		# The error is printed to the console automatically, but try to
272		# show it in a dialog too (this is helpful if the argument list
273		# was too long).
274		system($p,'-geometry',$g,'message','Error',"Could not execute $p:\n$!");
275		return 0;
276	}
277	return $e==0 ? 1 : 0;
278}
279
280
281sub DlgRead
282	# Like Dlg, but read pipe.
283{
284	my $hdl;
285	my $pid=open($hdl,'-|');
286		# ??? Requires Perl 5.8 (or 5.6???) and does not work on every OS.
287	if (!$pid) {
288		# Child process
289		my $r=Dlg(@_);
290		print(":$r");
291		exit(0);
292	}
293	my $res;
294	read($hdl,$res,1000000);
295	if (!defined($res)) { return undef; }
296	if (substr($res,length($res)-2,2) ne ":1") { return undef; }
297	$res=substr($res,0,length($res)-2);
298	while (length($res)>0 && ord(substr($res,length($res)-1,1))<32) {
299		$res=substr($res,0,length($res)-1);
300	}
301	return $res;
302}
303
304
305sub Message
306	# Show a message dialog.
307	# Arguments: <title>, <message>
308{
309	Dlg("message",@_);
310}
311
312
313sub Error
314	# Show an error message in a dialog box and exit.
315	# Arguments: <error message>
316{
317	Message("Error",@_);
318	exit(1);
319}
320
321
322sub Warning
323	# Show a warning message in a dialog box (does not exit).
324	# Arguments: <warning message>
325{
326	Message("Warning",@_);
327}
328
329
330sub Confirm
331	# Show a message dialog with OK and Cancel buttons. Exits on
332	# cancellation.
333	# Arguments: <title>, <message>
334{
335	if (!Dlg("confirm",@_)) { exit(1); }
336}
337
338
339sub Edit
340	# Show a dialog for editing a string. Exits on cancellation.
341	# Arguments: <title>, <question>, <initial string value>
342	# Returns: the string
343{
344	my $res=DlgRead("edit",@_);
345	if (!defined($res)) { exit(1); }
346	if ($res =~ /[\x00-\x1F\x7F]/) {
347		Error("The edited text contains a control character. That is not allowed.");
348	}
349	return $res;
350}
351
352
353sub FilenameEdit
354	# Like Edit, but for editing a file or directory name.
355{
356	my $name=Edit(@_);
357	CheckFilename($name);
358	return $name;
359}
360
361
362sub PasswordEdit
363	# Like Edit, but for editing a password.
364{
365	my $res=DlgRead("pwedit",@_);
366	if (!defined($res)) { exit(1); }
367	if ($res =~ /[\x00-\x1F\x7F]/) {
368		Error("The password contains a control character. That is not allowed.");
369	}
370	return $res;
371}
372
373
374#============================== Selection errors ===============================
375
376sub ErrorIfNoSources
377{
378	if (@Src<1) { Error("No source selected."); }
379}
380
381
382sub ErrorIfNoTargets
383{
384	if (@Tgt<1) { Error("No target selected."); }
385}
386
387
388sub ErrorIfMultipleSources
389{
390	if (@Src>1) { Error("Multiple sources selected."); }
391}
392
393
394sub ErrorIfMultipleTargets
395{
396	if (@Tgt>1) { Error("Multiple targets selected."); }
397}
398
399
400sub ErrorIfNotSingleSource
401{
402	ErrorIfNoSources();
403	ErrorIfMultipleSources();
404}
405
406
407sub ErrorIfNotSingleTarget
408{
409	ErrorIfNoTargets();
410	ErrorIfMultipleTargets();
411}
412
413
414sub ErrorIfSourcesNotDirs
415{
416	for (my $i=0; $i<@Src; $i++) {
417		if (! -d $Src[$i]) { Error("Non-directory selected as source."); }
418	}
419}
420
421
422sub ErrorIfTargetsNotDirs
423{
424	for (my $i=0; $i<@Tgt; $i++) {
425		if (! -d $Tgt[$i]) { Error("Non-directory selected as target."); }
426	}
427}
428
429
430sub ErrorIfSourcesNotFiles
431{
432	for (my $i=0; $i<@Src; $i++) {
433		if (! -f $Src[$i]) { Error("Non-file selected as source."); }
434	}
435}
436
437
438sub ErrorIfTargetsNotFiles
439{
440	for (my $i=0; $i<@Tgt; $i++) {
441		if (! -f $Tgt[$i]) { Error("Non-file selected as target."); }
442	}
443}
444
445
446sub ErrorIfSourcesAcrossDirs
447{
448	if (@Src>1) {
449		my ($f0,$d0)=fileparse($Src[0]);
450		for (my $i=1; $i<@Src; $i++) {
451			my ($f,$d)=fileparse($Src[$i]);
452			if ($d ne $d0) {
453				Error(
454					"Sources selected from different directories."
455				);
456			}
457		}
458	}
459}
460
461
462sub ErrorIfTargetsAcrossDirs
463{
464	if (@Tgt>1) {
465		my ($f0,$d0)=fileparse($Tgt[0]);
466		for (my $i=1; $i<@Tgt; $i++) {
467			my ($f,$d)=fileparse($Tgt[$i]);
468			if ($d ne $d0) {
469				Error(
470					"Targets selected from different directories."
471				);
472			}
473		}
474	}
475}
476
477
478sub ErrorIfRootSources
479{
480	for (my $i=0; $i<@Src; $i++) {
481		if ($Src[$i] eq '/') { Error("Root directory selected as source."); }
482	}
483}
484
485
486sub ErrorIfRootTargets
487{
488	for (my $i=0; $i<@Tgt; $i++) {
489		if ($Tgt[$i] eq '/') { Error("Root directory selected as target."); }
490	}
491}
492
493
494#=========================== Selection confirmations ===========================
495
496sub ConfirmIfSourcesAcrossDirs
497{
498	if (@Src>1) {
499		my ($f0,$d0)=fileparse($Src[0]);
500		for (my $i=1; $i<@Src; $i++) {
501			my ($f,$d)=fileparse($Src[$i]);
502			if ($d ne $d0) {
503				Confirm("Warning",
504					"Sources are selected from different directories.\n".
505					"Are you sure this is correct?"
506				);
507				last;
508			}
509		}
510	}
511}
512
513
514sub ConfirmIfTargetsAcrossDirs
515{
516	if (@Tgt>1) {
517		my ($f0,$d0)=fileparse($Tgt[0]);
518		for (my $i=1; $i<@Tgt; $i++) {
519			my ($f,$d)=fileparse($Tgt[$i]);
520			if ($d ne $d0) {
521				Confirm("Warning",
522					"Targets are selected from different directories.\n".
523					"Are you sure this is correct?"
524				);
525				last;
526			}
527		}
528	}
529}
530
531
532sub ConfirmToOpenIfManyTargets
533{
534	my $n=@Tgt;
535	if ($n>10) {
536		Confirm("Warning","Do you really want to open $n files at once?");
537	}
538}
539
540
541#==================== Further helpers for dialoged session =====================
542
543sub ChDirOrError
544	# Change the current directory. On error, show an error message and exit.
545	# Arguments: <directory>
546{
547	if (!chdir($_[0])) {
548		Error("Cannot chdir to '$_[0]': $!");
549	}
550}
551
552
553sub ExecOrError
554	# Start a program and exit, show an error message if starting fails.
555	# Arguments: <program> [,<arguments>...]
556{
557	if (!exec({$_[0]} @_)) { # 'if' required only for suppressing a warning.
558		Error("Failed to run $_[0]: $!");
559	}
560	# never coming here
561}
562
563
564#====================== Helpers for the terminal session =======================
565
566sub TermRun
567	# Print and run a program, return the exit status (non-zero on error).
568	# Arguments: <program> [,<arguments>...]
569{
570	print("\n${TCInfo}Running: ".join(' ',@_)."${TCNormal}\n\n");
571	return system({$_[0]} @_);
572}
573
574
575sub TermSync
576	# Print and run the sync command, return the exit status (non-zero on error).
577	# This is now disabled by default (see $Sync in configuration more above).
578{
579	if ((lc($Sync) eq 'yes' || lc($Sync) eq 'true' || $Sync eq '1')) {
580		return TermRun("sync");
581	}
582	else {
583		return 0;
584	}
585}
586
587
588sub TermRunAndSync
589	# Combination of TermRun and TermSync
590{
591	my $e=TermRun(@_);
592	$e|=TermSync();
593	return $e;
594}
595
596
597sub TermChDir
598	# Change the current directory, return non-zero on error.
599	# Arguments: <directory>
600{
601	print("\n${TCInfo}Setting current directory: $_[0]${TCNormal}\n");
602	if (!chdir($_[0])) {
603		print("Cannot chdir to '$_[0]': $!");
604		return 1;
605	}
606	return 0;
607}
608
609
610sub TermEnd
611	# End the terminal session: Print a message whether there was an error.
612	# Wait for user input on error. Then exit.
613	# Arguments: <non-zero for error>
614{
615	if ($_[0]!=0) {
616		print(
617			"\n".
618			"${TCError}ERROR!${TCNormal}\n".
619			"\n".
620			"${TCClose}Read the messages, then press enter or close the terminal.${TCNormal}\n"
621		);
622		readline(*STDIN);
623		exit(1);
624	}
625	else {
626		print(
627			"\n".
628			"${TCSuccess}SUCCESS!${TCNormal}\n".
629			"\n"
630		);
631		sleep(1);
632		exit(0);
633	}
634}
635
636
637sub TermEndByUser
638	# Like TermEnd, but always let the user close the terminal.
639	# Arguments: <non-zero for error>
640{
641	if ($_[0]!=0) {
642		print(
643			"\n".
644			"${TCError}ERROR!${TCNormal}\n".
645			"\n".
646			"${TCClose}Read the messages, then press enter or close the terminal.${TCNormal}\n"
647		);
648		readline(*STDIN);
649		exit(1);
650	}
651	else {
652		print(
653			"\n".
654			"${TCClose}Read the messages, then press enter or close the terminal.${TCNormal}\n"
655		);
656		readline(*STDIN);
657		exit(0);
658	}
659}
660
661
662#==================== Hi-level functions for frequent cases ====================
663
664sub OpenSingleTargetFileWith
665{
666	ErrorIfNotSingleTarget();
667	ErrorIfTargetsNotFiles();
668	my @tgt=GetTgt();
669	ChDirOrError(dirname($tgt[0]));
670	ExecOrError(@_,$tgt[0]);
671}
672
673
674sub OpenSingleTargetDirWith
675{
676	ErrorIfNotSingleTarget();
677	ErrorIfTargetsNotDirs();
678	my @tgt=GetTgt();
679	ExecOrError(@_,$tgt[0]);
680}
681
682
683sub OpenSingleTargetWith
684{
685	ErrorIfNotSingleTarget();
686	my @tgt=GetTgt();
687	ExecOrError(@_,$tgt[0]);
688}
689
690
691sub OpenTargetFilesWith
692{
693	ErrorIfNoTargets();
694	ErrorIfTargetsNotFiles();
695	ConfirmToOpenIfManyTargets();
696	my @tgt=GetTgt();
697	ChDirOrError(dirname($tgt[0]));
698	ExecOrError(@_,@tgt);
699}
700
701
702sub OpenTargetDirsWith
703{
704	ErrorIfNoTargets();
705	ErrorIfTargetsNotDirs();
706	ConfirmToOpenIfManyTargets();
707	my @tgt=GetTgt();
708	ExecOrError(@_,@tgt);
709}
710
711
712sub OpenTargetsWith
713{
714	ErrorIfNoTargets();
715	ConfirmToOpenIfManyTargets();
716	my @tgt=GetTgt();
717	ExecOrError(@_,@tgt);
718}
719
720
721sub PackType
722{
723	my $type=shift;
724
725	if (IsFirstPass()) {
726
727		ErrorIfNoSources();
728		ErrorIfSourcesAcrossDirs();
729		ErrorIfNotSingleTarget();
730		ErrorIfTargetsNotDirs();
731
732		my @src=GetSrc();
733		my @tgt=GetTgt();
734		my ($srcName0,$srcDir)=fileparse($src[0]);
735		my $dir=$tgt[0];
736		my $name = "archive";
737		if (@src == 1) {
738			$name = $srcName0;
739		}
740		$name = $name . '.' . $type;
741
742		$name=FilenameEdit(
743			"Pack $type",
744			"Please enter a name for the new $type archive in:\n\n$dir",
745			$name
746		);
747
748		if (-e catfile($dir,$name)) {
749			Error("A file or directory of that name already exists.");
750		}
751
752		ChDirOrError($srcDir);
753
754		SetFirstPassResult($name);
755
756		SecondPassInTerminal("Pack $type");
757	}
758
759	my @src=GetSrc();
760	my @tgt=GetTgt();
761	my ($srcName0,$srcDir)=fileparse($src[0]);
762	my $dir=$tgt[0];
763	my $name=GetFirstPassResult();
764	my $path=catfile($dir,$name);
765
766	my @srcNames;
767	for (my $i=0; $i<@src; $i++) {
768		my $n=fileparse($src[$i]);
769		push(@srcNames,$n);
770	}
771
772	my $e=TermRunAndSync(
773		catfile($ENV{'EM_DIR'},'res','emFileMan','scripts','emArch.sh'),
774		"pack",
775		"-f",
776		"$type",
777		"--",
778		$path,
779		@srcNames
780	);
781
782	if (-e $path) {
783		SendSelect($path);
784	}
785	else {
786		SendUpdate();
787	}
788
789	TermEnd($e);
790}
791
792
793#===============================================================================
794
795return 1; # Because this file is used like a module.
796