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