1#!
2#[[BEGIN PROPERTIES]]
3# Type = Command
4# Order = 3.0
5# Interpreter = perl
6# Caption = Select Recursively
7# Descr =Recursively select files and/or directories whose names match a
8# Descr =pattern. The pattern is asked. The matching entries are listed
9# Descr =in a terminal and selected as the target. The source selection
10# Descr =is kept unchanged.
11# Descr =
12# Descr =Selection details:
13# Descr =
14# Descr =  Source: Ignored.
15# Descr =
16# Descr =  Target: The files and directories to be taken for the pattern
17# Descr =          test. Directories are scanned recursively.
18# Icon = select_files_recursively.tga
19# Hotkey = Ctrl+S
20#[[END PROPERTIES]]
21
22use strict;
23use warnings;
24BEGIN { require "$ENV{'EM_DIR'}/res/emFileMan/scripts/cmd-util.pl"; }
25
26if (IsFirstPass()) {
27
28	ErrorIfNoTargets();
29
30	my $pattern=Edit(
31		"Select Recursively",
32		"Please enter a pattern for the names of the entries which shall be selected.\n".
33		"\n".
34		"For this pattern matching, directory names have a slash (\"/\") at the end.\n".
35		"\n".
36		"Special characters in the pattern are:\n".
37		"  *  Matches any character sequence, but not the slash of a directory name.\n".
38		"  ?  Matches any single character, but not the slash of a directory name.\n".
39		"  |  Or-operator for multiple patterns.\n".
40		"\n".
41		"Examples:\n".
42		"  *          Select all files.\n".
43		"  */         Select all directories.\n".
44		"  *|*/       Select all files and directories.\n".
45		"  README     Select all files named \"README\".\n".
46		"  CVS/       Select all directories named \"CVS\".\n".
47		"  *.txt      Select all files ending with \".txt\".\n".
48		"  *.cpp|*.h  Select all files ending with \".cpp\" or \".h\".\n".
49		"  a*/|b*/    Select all directories beginning with \"a\" or \"b\".",
50		"*"
51	);
52
53	SetFirstPassResult($pattern);
54
55	SecondPassInTerminal("Select Recursively");
56}
57
58my $pattern=GetFirstPassResult();
59my $regEx='(^';
60for (my $i=0; $i<length($pattern); $i++) {
61	my $c=substr($pattern,$i,1);
62	if ($c eq '*') { $regEx.='[^/]*'; }
63	elsif ($c eq '?') { $regEx.='[^/]'; }
64	elsif ($c eq '|') { $regEx.='$)|(^'; }
65	elsif (index('^|?/.()[]{}$*\\+',$c)>=0) { $regEx.="\\$c"; }
66	else { $regEx.=$c; }
67}
68$regEx.='$)';
69
70my @found=();
71my $foundAnyHidden=0;
72
73sub SrDoPathName
74{
75	my $path=shift;
76	my $name=shift;
77	my $pathname=catfile($path,$name);
78	my $foundAny=0;
79
80	if (@found>10000) { #???
81		print("\nToo many entries found.\n");
82		TermEndByUser(1);
83	}
84
85	if (-d $pathname) {
86		if ("$name/" =~ /$regEx/) {
87			push(@found,$pathname);
88			print("$pathname/\n");
89			$foundAny=1;
90		}
91		my $dh;
92		my @list=();
93		if (!opendir($dh,$pathname)) {
94			print("\nFailed to read directory $pathname: $!\n");
95			TermEndByUser(1);
96		}
97		while (defined(my $n=readdir($dh))) {
98			if ($n ne '.' && $n ne '..') {
99				push(@list,$n);
100			}
101		}
102		closedir($dh);
103		@list=sort(@list);
104		for (my $i=0; $i<@list; $i++) {
105			if (SrDoPathName($pathname,$list[$i])) {
106				$foundAny=1;
107			}
108		}
109	}
110	else {
111		if ($name =~ /$regEx/) {
112			push(@found,$pathname);
113			print("$pathname\n");
114			$foundAny=1;
115		}
116	}
117	if (
118		$foundAny &&
119		substr($name,0,1) eq '.' # ??? UNIX specific
120	) {
121		$foundAnyHidden=1;
122	}
123
124	return $foundAny;
125}
126
127print("\nFound the following files and directories:\n\n");
128my @tgt=GetTgt();
129for (my $i=0; $i<@tgt; $i++) {
130	my ($name,$path)=fileparse($tgt[$i]);
131	SrDoPathName($path,$name);
132}
133
134if (@found>0) {
135	print("\nSelecting the found entries as the target.\n");
136}
137else {
138	print("\nNo matching entries found - clearing target selection.\n");
139}
140SendSelectKS(@found);
141
142if ($foundAnyHidden) {
143	Warning(
144		"Warning: There are hidden files or directories which\n".
145		"match the pattern and which have been selected."
146	);
147}
148
149TermEndByUser(0);
150