1#! 2#[[BEGIN PROPERTIES]] 3# Type = Command 4# Order = 52.0 5# Interpreter = perl 6# Caption = Unpack New Dir 7# Descr =Create a new subdirectory and unpack an archive file into it. The 8# Descr =name is asked. 9# Descr = 10# Descr =Selection details: 11# Descr = 12# Descr = Source: The archive file. 13# Descr = 14# Descr = Target: The directory in which the new subdirectory shall be 15# Descr = created. 16# Descr = 17# Descr =Following archive file formats are supported, provided that the 18# Descr =corresponding system tools are installed: 7z, a, ar, bz, bz2, deb, 19# Descr =gz, ipk, jar, lzma, lzo, tar, tar.bz, tar.bz2, tar.gz, tar.lzma, 20# Descr =tar.lzo, tar.xz, tar.Z, taz, tbz, tbz2, tgj, tgz, tlz, txz, tzo, 21# Descr =xz, Z, zip 22# Icon = unpack_file_in_new_dir.tga 23# Hotkey = Meta+U 24#[[END PROPERTIES]] 25 26use strict; 27use warnings; 28BEGIN { require "$ENV{'EM_DIR'}/res/emFileMan/scripts/cmd-util.pl"; } 29 30if (IsFirstPass()) { 31 32 ErrorIfNotSingleSource(); 33 ErrorIfNotSingleTarget(); 34 ErrorIfSourcesNotFiles(); 35 ErrorIfTargetsNotDirs(); 36 37 my @src=GetSrc(); 38 my @tgt=GetTgt(); 39 40 my $dir=$tgt[0]; 41 42 my $name=basename($src[0]); 43 my $i=rindex($name,'.'); 44 if ($i<=0) { 45 $name.='.unpacked'; 46 } 47 else { 48 $name=substr($name,0,$i); 49 $i=rindex($name,'.'); 50 if ($i>0) { 51 my $s2=lc(substr($name,$i)); 52 if ($s2 eq '.tar') { 53 $name=substr($name,0,$i); 54 } 55 } 56 } 57 58 $name=FilenameEdit( 59 "Unpack New Dir", 60 "Please enter a name for a new subdirectory in\n". 61 "\n". 62 " $dir\n". 63 "\n". 64 "in order to unpack the archive file\n". 65 "\n". 66 " $src[0]\n". 67 "\n". 68 "into that new subdirectory.", 69 $name 70 ); 71 72 my $path=catfile($dir,$name); 73 74 if (-e $path) { 75 Error("A file or directory of that name already exists"); 76 } 77 78 SetFirstPassResult($path); 79 80 SecondPassInTerminal("Unpack New Dir"); 81} 82 83my @src=GetSrc(); 84my $path=GetFirstPassResult(); 85 86my $e=TermRun( 87 "mkdir", 88 "-v", 89 "--", 90 $path 91); 92 93if ($e == 0) { 94 $e=TermChDir($path); 95 if ($e == 0) { 96 $e=TermRunAndSync( 97 catfile($ENV{'EM_DIR'},'res','emFileMan','scripts','emArch.sh'), 98 "unpack", 99 "--", 100 $src[0] 101 ); 102 } 103} 104 105if (-e $path) { 106 SendSelectKS($path); 107} 108else { 109 SendUpdate(); 110} 111 112TermEnd($e); 113