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