9 # Initial Contributors: |
9 # Initial Contributors: |
10 # Nokia Corporation - initial contribution. |
10 # Nokia Corporation - initial contribution. |
11 # |
11 # |
12 # Contributors: |
12 # Contributors: |
13 # |
13 # |
14 # Description: iMaker main Perl script |
14 # Description: iMaker main Perl script & common routines |
15 # |
15 # |
16 |
16 |
17 |
17 |
18 |
18 |
19 # |
19 # |
20 $(error >>>MAKECMDGOALS=$(MAKECMDGOALS)<<<) |
20 $(error |MAKE=$(MAKE)|MAKE_VERSION=$(MAKE_VERSION)|SHELL=$(SHELL)|MAKECMDGOALS=$(MAKECMDGOALS)|) |
21 # |
21 # |
22 #!perl |
22 #!perl |
|
23 #line 24 |
|
24 |
|
25 use subs qw(CORE::GLOBAL::die); |
23 |
26 |
24 use strict; |
27 use strict; |
25 use warnings; |
28 use warnings; |
26 use Getopt::Long qw(:config pass_through no_auto_abbrev); |
29 use Cwd; |
27 |
30 use Digest::MD5 qw(md5_hex); |
28 my $error = ""; |
31 use File::Basename; |
29 my $perlver; |
32 use File::Copy; |
30 my $start; |
33 use File::Find; |
|
34 use File::Path; |
|
35 use File::Spec; |
|
36 use File::Temp qw(tempfile); |
|
37 use POSIX qw(strftime); |
|
38 use Text::ParseWords; |
|
39 use Time::Local; |
|
40 |
|
41 sub InitMkglobals(); |
|
42 sub PrintEnv($); |
|
43 sub Max(@); |
|
44 sub Min(@); |
|
45 sub Trim($;$); |
|
46 sub Quote($); |
|
47 sub Unquote($); |
|
48 sub Int2Hex($;$); |
|
49 sub Byte2Str($@); |
|
50 sub Str2Byte($); |
|
51 sub Str2Xml($); |
|
52 sub Ascii2Uni($); |
|
53 sub Uni2Ascii($); |
|
54 sub GetTimestamp(); |
|
55 sub Sec2Min($); |
|
56 sub Wcard2Restr($); |
|
57 sub Wcard2Regex($); |
|
58 sub ParseCmdWords($); |
|
59 sub DPrint($@); |
|
60 sub Echo($$$); |
|
61 sub PathConv($;$$$); |
|
62 sub ParseFiles($); |
|
63 sub GlobFiles($;$); |
|
64 sub GetBasename($); |
|
65 sub GetDirname($); |
|
66 sub GetAbsDirname($;$$$); |
|
67 sub GetAbsFname($;$$$); |
|
68 sub GetRelFname($;$$); |
|
69 sub GetWriteFname($); |
|
70 sub GetFreeDrive(;$); |
|
71 sub SubstDrive($$); |
|
72 sub UnsubstDrive($); |
|
73 sub Search($$$$$$\@\$); |
|
74 sub Find($$$$$\$); |
|
75 sub ChangeDir($); |
|
76 sub DeleteDir($;$); |
|
77 sub FindDir($$$$); |
|
78 sub MakeDir($); |
|
79 sub MakeChangeDir($); |
|
80 sub SetWorkdir($); |
|
81 sub OpenFile(*$$;$); |
|
82 sub Test($); |
|
83 sub CutFile($$$$$); |
|
84 sub Copy($$;$); |
|
85 sub CopyIby($$); |
|
86 sub DeleteFile($;$); |
|
87 sub FindFile($$$$); |
|
88 sub HeadFile($$$); |
|
89 sub TailFile($$$); |
|
90 sub TypeFile($;$); |
|
91 sub ReadFile($$); |
|
92 sub WriteFile($$$;$$); |
|
93 sub UnzipFile($$); |
|
94 sub Zip($$$$@); |
|
95 sub Move($$); |
|
96 sub Touch($@); |
|
97 sub SetLogfile($); |
|
98 sub RunSystemCmd($;$$$); |
|
99 sub ParseSystemCmd($$$$$); |
|
100 sub GenExclfile($$$$$); |
|
101 sub GenIbyfile($$$); |
|
102 sub GenObyfile($$$$@); |
|
103 sub GenMakefile($$$$$); |
|
104 sub GenWidgetConf($$$$); |
|
105 sub AddImageHeader($$$$$); |
|
106 sub Sleep($); |
|
107 sub FindSOSFiles($$$$); |
|
108 sub CheckTool(@); |
|
109 sub OpCacheInstall($$$); |
|
110 sub SisInstall($$$$$$$$); |
|
111 sub GetIPar(;$); |
|
112 sub PEval($); |
|
113 sub PeekICmd($); |
|
114 sub SkipICmd(); |
|
115 sub GetICmd(); |
|
116 sub EndICmd(); |
|
117 sub SplitStep($); |
|
118 sub RunStep($); |
|
119 sub RunIExtCmd($); |
|
120 sub GetConfmkList(;$); |
|
121 sub GetFeatvarIncdir($); |
|
122 sub SetVerbose($;$); |
|
123 sub CloseLog(); |
|
124 sub RunIMakerCmd($$$$$@); |
|
125 sub RunMakeCmd($$); |
|
126 sub HandleCmdArg($); |
|
127 sub HandleExtCmdArg($); |
|
128 sub MenuRuncmd($); |
|
129 sub Menu($); |
|
130 sub Install($$$); |
|
131 |
|
132 use constant READBUFSIZE => 2097152; # 2 MB |
|
133 use constant STARTSTR => '>>>[START]=========8<==========8<==========8<==========8<==========8<=========='; |
|
134 use constant ENDSTR => '==========>8==========>8==========>8==========>8==========>8===========[END]<<<'; |
|
135 |
|
136 # device[VARID]==... !! |
|
137 # |
|
138 use constant BOOTBINARYSTATEMENT => qr/^\s*bootbinary\s*(?:=+|\s)\s*(?:"(.+?)"|(\S+))/i; |
|
139 |
|
140 use constant FILESPECSTATEMENT => |
|
141 qr/^\s*(?:data|device|dll|extension|file|primary|secondary|variant)\S*?\s*(?:=+|\s)\s*(?:"(.+?)"|(\S+))\s+(?:"(.+?)"|(\S+))(\s+.+?)?\s*$/i; |
|
142 |
|
143 our ($gArgv, $gCmdcnt, @gCmdoutbuf, %gConfmkList, $gEpocdrive, $gEpocroot, $gError, $gErrwarn, $gEvalerr, |
|
144 %gExportvar, $gFiltercmd, @gFindresult, $gICmd, @gIcmd, $gImakerext, $gImgtype, $gKeepgoing, @gLogbuf, |
|
145 $gLogfile, %gLogfiles, $gMakecmd, @gMakeinfo, $gOutfilter, $gParamcnt, $gPrintcmd, @gReport, $gStartmk, |
|
146 $gStarttime, $gStep, @gStepDur, %gStepIcmd, %gSubstdrv, $gTgterr, %gTool, $gVerbose, $gWinOS, $gWorkdir, |
|
147 $gWorkdrive, @iVar); |
|
148 |
|
149 |
|
150 ############################################################################### |
|
151 # |
|
152 |
|
153 sub InitMkglobals() |
|
154 { |
|
155 $gCmdcnt = 0; |
|
156 @gCmdoutbuf = (); |
|
157 $gFiltercmd = qr/\S/; |
|
158 @gFindresult = (); |
|
159 $gICmd = ""; |
|
160 @gIcmd = (); |
|
161 $gImgtype = ""; |
|
162 $gOutfilter = ""; |
|
163 $gParamcnt = 0; |
|
164 $gPrintcmd = 0; |
|
165 $gStep = ""; |
|
166 @gStepDur = (); |
|
167 %gStepIcmd = (); |
|
168 @iVar = (); # General purpose variable to be used from $(call peval,...) |
|
169 } |
31 |
170 |
32 BEGIN { |
171 BEGIN { |
33 ($start, $perlver) = (time(), sprintf("%vd", $^V)); |
172 ($gArgv, $gEvalerr, $gStarttime, $gWinOS) = (scalar(@ARGV), 0, time(), $^O =~ /MSWin/i); |
|
173 $_ = "default input and pattern-searching space"; |
|
174 eval("use Archive::Zip qw(:ERROR_CODES)"); |
|
175 eval("use constant AZ_OK => -1") if $@; |
|
176 eval("use Archive::Zip::Tree"); |
|
177 if ($gWinOS) { eval(" |
|
178 use Win32API::File qw(:DDD_); |
|
179 use Win32::File; |
|
180 use constant WIN32_FILE_HIDDEN => Win32::File::HIDDEN"); |
|
181 } else { eval(" |
|
182 use constant DDD_REMOVE_DEFINITION => -1; |
|
183 use constant WIN32_FILE_HIDDEN => -1"); |
|
184 } |
|
185 } |
|
186 |
|
187 INIT { |
|
188 $gWorkdir = Cwd::cwd(); |
|
189 $gWorkdrive = ($gWorkdir =~ /^([a-z]:)/i ? uc($1) : ""); |
|
190 $ENV{EPOCROOT} = ($gWinOS ? "\\" : "$gWorkdir/") if !$ENV{EPOCROOT}; |
|
191 $ENV{IMAKER_CMDARG} = "" if !defined($ENV{IMAKER_CMDARG}); |
|
192 $ENV{IMAKER_CYGWIN} = 0 if !$ENV{IMAKER_CYGWIN}; |
|
193 |
|
194 InitMkglobals(); |
|
195 %gConfmkList = (); |
|
196 $gEpocdrive = ($ENV{EPOCROOT} =~ /^([a-z]:)/i ? uc($1) : $gWorkdrive); |
|
197 ($gEpocroot = GetAbsDirname($ENV{EPOCROOT})) =~ s/\/+$//; |
|
198 $gError = 0; |
|
199 $gErrwarn = 0; |
|
200 %gExportvar = (); $gExportvar{""} = 0; |
|
201 $gKeepgoing = 0; |
|
202 @gLogbuf = (); |
|
203 $gLogfile = ""; |
|
204 %gLogfiles = (); |
|
205 $gMakecmd = ""; |
|
206 @gMakeinfo = ("?", "?", "?"); |
|
207 @gReport = (); |
|
208 $gStartmk = 0; |
|
209 %gSubstdrv = (); |
|
210 $gTgterr = 0; |
|
211 %gTool = (); map{ $gTool{$_} => $_ } ("cpp", "elf2e32", "interpretsis", "opcache", "unzip"); |
|
212 $gVerbose = 1; |
|
213 |
34 select(STDERR); $|++; |
214 select(STDERR); $|++; |
35 select(STDOUT); $|++; |
215 select(STDOUT); $|++; |
36 if (!@ARGV) { |
216 |
37 warn("Warning: iMaker is running under Cygwin!\n") |
217 # Overload die |
|
218 *CORE::GLOBAL::die = sub { |
|
219 $gError = 1 if !$gEvalerr; |
|
220 return if (PeekICmd("iferror") && !$gEvalerr); |
|
221 CORE::die(@_) if ($gEvalerr || !$gKeepgoing); |
|
222 $gErrwarn = 1; |
|
223 warn(@_); |
|
224 }; |
|
225 |
|
226 # Handler for __DIE__ signal |
|
227 $SIG{__DIE__} = sub { |
|
228 return if $gEvalerr; |
|
229 $gErrwarn = 1; |
|
230 warn(@_); |
|
231 exit(1); |
|
232 }; |
|
233 |
|
234 # Handler for __WARN__ signal |
|
235 $SIG{__WARN__} = sub { |
|
236 if (($gEvalerr != 1) && ($gKeepgoing < 3) && ($_[0] ne "\n")) { |
|
237 select(STDERR); |
|
238 my $msg = ($gStep ? "($gStep): " : "") . $_[0]; |
|
239 if ($gErrwarn && ($gKeepgoing < 2)) { |
|
240 DPrint(0, "*** Error: $msg") } |
|
241 else { DPrint(127, "Warning: $msg") } |
|
242 select(STDOUT); |
|
243 } |
|
244 $gErrwarn = 0; |
|
245 }; |
|
246 |
|
247 if (!$gArgv) { |
|
248 warn("iMaker is running under Cygwin!\n") |
38 if (!$ENV{IMAKER_CYGWIN} && $^O =~ /cygwin/i); |
249 if (!$ENV{IMAKER_CYGWIN} && $^O =~ /cygwin/i); |
39 warn("Warning: iMaker uses Perl version $perlver! Recommended versions are 5.6.1 and 5.8.8.\n") |
250 my $perlver = sprintf("%vd", $^V); |
40 if ($perlver !~ /^5\.(6\.1|8\.8)$/); |
251 warn("iMaker uses Perl version $perlver! Recommended versions are 5.6.1, 5.8.x and 5.10.x.\n") |
41 } |
252 if ($perlver !~ /^5\.(?:6\.1|(?:8|10)\.\d+)$/); |
42 unshift(@INC, defined($ENV{IMAKER_DIR}) ? $ENV{IMAKER_DIR} : ($0 =~ /^(.*)[\/\\]/ ? $1 : ".")); |
253 } |
43 } |
254 } |
44 |
|
45 use imaker; |
|
46 |
255 |
47 |
256 |
48 ############################################################################### |
257 ############################################################################### |
49 # Main program |
258 # Main program |
50 |
259 |
51 { |
260 { |
52 if (!@ARGV) { |
261 if ($gArgv) { |
53 $ENV{CONFIGROOT} = imaker::GetAbsDirname($ENV{CONFIGROOT}); |
262 my $iopt = shift(@ARGV); |
54 $ENV{ITOOL_DIR} = imaker::GetAbsDirname($ENV{ITOOL_DIR}, 0, 1); |
263 print(map("$_\n", GetFeatvarIncdir("@ARGV"))), exit(0) if ($iopt eq "--incdir"); |
55 $ENV{IMAKER_DIR} = imaker::GetAbsDirname($ENV{IMAKER_DIR}, 0, 1); |
264 print(map("$_\n", @ARGV)), exit(0) if ($iopt eq "--splitarg"); |
56 $ENV{PATH} = join(";", grep(!/[\\\/]cygwin[\\\/]/i, split(/;+/, $ENV{PATH}))) |
265 die("Unknown internal imaker.pl option: `$iopt'.\n"); |
57 if $imaker::gWinOS && !$ENV{IMAKER_CYGWIN}; |
266 } |
58 |
267 |
59 my ($version, $verfile) = ("", "$ENV{IMAKER_DIR}/imaker_version.mk"); |
268 delete($ENV{MAKE}) if $gWinOS; |
60 open(FILE, "<$verfile") and map { $version = $1 if /^\s*IMAKER_VERSION\s*[+:?]?=\s*(.*?)\s*$/ } <FILE>; |
269 map { delete($ENV{$_}) } qw(MAKECMDGOALS MAKEFILES MAKEFLAGS MAKELEVEL MAKE_VERSION); |
|
270 |
|
271 $ENV{CONFIGROOT} = GetAbsDirname($ENV{CONFIGROOT} || "$gEpocroot/epoc32/rom/config"); |
|
272 $ENV{ITOOL_DIR} = GetAbsDirname($ENV{ITOOL_DIR} || "$gEpocroot/epoc32/tools/rom"); |
|
273 $ENV{IMAKER_DIR} = GetAbsDirname($ENV{IMAKER_DIR}); |
|
274 |
|
275 $ENV{IMAKER_EXPORTMK} = ""; |
|
276 $ENV{IMAKER_MAKE} = ($gWinOS ? "$ENV{IMAKER_DIR}/mingw_make.exe" : $ENV{MAKE} || "make") if !$ENV{IMAKER_MAKE}; |
|
277 $ENV{IMAKER_MAKESHELL} = ($ENV{COMSPEC} || "cmd.exe") if (!$ENV{IMAKER_MAKESHELL} && $gWinOS); |
|
278 $ENV{IMAKER_MKCONF} = $ENV{CONFIGROOT} . ',image_conf_(.+?)\.mk$,_(?:ncp)?\d+\.mk$,1' if !$ENV{IMAKER_MKCONF}; |
|
279 |
|
280 my $pathsep = ($gWinOS ? ";" : ":"); |
|
281 $ENV{PATH} = join(";", grep(!/[\\\/]cygwin[\\\/]/i, split(/;+/, $ENV{PATH}))) if (!$ENV{IMAKER_CYGWIN} && $gWinOS); |
|
282 ($ENV{PATH} = Trim($ENV{PATH})) =~ s/"$/";/ if $gWinOS; # http://savannah.gnu.org/bugs/index.php?25412 |
|
283 $ENV{PATH} = PathConv("$ENV{ITOOL_DIR}", $gWinOS) . $pathsep . PathConv("$gEpocroot/epoc32/tools", $gWinOS) . |
|
284 $pathsep . ($gWinOS ? PathConv("$gEpocroot/epoc32/gcc/bin", 1) . ";" : "") . $ENV{PATH}; |
|
285 |
|
286 $ENV{PERL5LIB} = $ENV{IMAKER_DIR} . ($ENV{PERL5LIB} ? "$pathsep$ENV{PERL5LIB}" : ""); |
|
287 |
|
288 die($@) if !defined($gImakerext = do("$ENV{IMAKER_DIR}/imaker_extension.pm")) && $@; |
|
289 |
|
290 my ($version, $verfile) = ("", "$ENV{IMAKER_DIR}/imaker_version.mk"); |
|
291 open(FILE, "<$verfile") and map { $version = $1 if /^\s*IMAKER_VERSION\s*[+:?]?=\s*(.*?)\s*$/ } <FILE>; |
|
292 close(FILE); |
|
293 if ($version) { DPrint(1, "$version\n") } |
|
294 else { warn("Can't read iMaker version from `$verfile'.\n") } |
|
295 |
|
296 if ($ENV{IMAKER_CMDARG} =~ /^\s*--?(install|clean)=?(.*?)\s*$/i) { |
|
297 Install(lc($1) eq "clean", "$ENV{IMAKER_DIR}/../group/bld.inf", $2); |
|
298 exit(0); |
|
299 } |
|
300 |
|
301 $gMakecmd = "$ENV{IMAKER_MAKE} -R --no-print-directory" . |
|
302 ($ENV{IMAKER_MAKESHELL} ? " SHELL=\"$ENV{IMAKER_MAKESHELL}\"" : ""); |
|
303 my $cmdout = qx($gMakecmd -f "$0" 2>&1); |
|
304 ($cmdout = (defined($cmdout) ? $cmdout : "")) =~ s/\n+$//; |
|
305 die("Can't run Make properly: `$cmdout'\n") |
|
306 if ($cmdout !~ /\|MAKE=(.*?)\|MAKE_VERSION=(.*?)\|SHELL=(.*?)\|/); |
|
307 @gMakeinfo = ($1, $2, $3); |
|
308 warn(($gMakeinfo[1] eq "" ? "Can't resolve Make version" : "iMaker uses Make version $gMakeinfo[1]") . |
|
309 ", recommended version is 3.81.\n") if ($gMakeinfo[1] !~ /^\s*3\.81/); |
|
310 |
|
311 RunIMakerCmd("$gMakecmd TIMESTAMP=" . GetTimestamp() . |
|
312 " -I \"$ENV{CONFIGROOT}\" -f \"$ENV{IMAKER_DIR}/imaker.mk\"", $ENV{IMAKER_CMDARG}, "", 0, 0, ()); |
|
313 } |
|
314 |
|
315 |
|
316 ############################################################################### |
|
317 # |
|
318 |
|
319 sub PrintEnv($) |
|
320 { |
|
321 return if !@gMakeinfo; |
|
322 DPrint(shift(), "=" x 79 . "\n" . |
|
323 "User : " . (getlogin() || "?") . "@" . ($ENV{HOSTNAME} || $ENV{COMPUTERNAME} || "?") . " on $^O\n" . |
|
324 "Time : " . localtime() . "\n" . |
|
325 "Current dir : `$gWorkdir'\n" . |
|
326 "iMaker tool : `$ENV{IMAKER_TOOL}' -> `$0'\n" . |
|
327 "Cmdline args: `$ENV{IMAKER_CMDARG}'\n" . |
|
328 "Perl : `$^X' version " . sprintf("%vd\n", $^V) . |
|
329 "PERL5LIB : `$ENV{PERL5LIB}'\n" . |
|
330 "PERL5OPT : `" . (defined($ENV{PERL5OPT}) ? "$ENV{PERL5OPT}'\n" : "'\n") . |
|
331 "Make : `$gMakeinfo[0]' version $gMakeinfo[1]\n" . |
|
332 "Make shell : `$gMakeinfo[2]'\n" . |
|
333 "EPOCROOT : `$ENV{EPOCROOT}'\n" . |
|
334 "CONFIGROOT : `$ENV{CONFIGROOT}'\n" . |
|
335 "PATH : `$ENV{PATH}'\n"); |
|
336 @gMakeinfo = (); |
|
337 } |
|
338 |
|
339 sub Max(@) |
|
340 { |
|
341 my $max = (shift() || 0); |
|
342 map { $max = $_ if $_ > $max } @_; |
|
343 return($max); |
|
344 } |
|
345 |
|
346 sub Min(@) |
|
347 { |
|
348 my $min = (shift() || 0); |
|
349 map { $min = $_ if $_ < $min } @_; |
|
350 return($min); |
|
351 } |
|
352 |
|
353 sub Trim($;$) |
|
354 { |
|
355 (my $str = shift()) =~ s/^\s+|\s+$//g; |
|
356 $str =~ s/\s+(?=\s)//g if shift(); |
|
357 return($str); |
|
358 } |
|
359 |
|
360 sub Quote($) |
|
361 { |
|
362 local $_ = shift(); |
|
363 return("") if !defined(); |
|
364 s/\\( |n|t)/\\\\$1/g; |
|
365 return($_); |
|
366 } |
|
367 |
|
368 sub Unquote($) |
|
369 { |
|
370 local $_ = shift(); |
|
371 return("") if !defined(); |
|
372 s/(?<!\\)(?<=\\n)\s+(\\n)?//g; |
|
373 s/(?<!\\)\s+(?=\\n)//g; |
|
374 s/(?<!\\)\\ / /g; |
|
375 s/(?<!\\)\\n/\n/g; |
|
376 s/(?<!\\)\\t/\t/g; |
|
377 s/\\\\( |n|t)/\\$1/g; |
|
378 s/\x00//g; |
|
379 return($_); |
|
380 } |
|
381 |
|
382 sub Int2Hex($;$) |
|
383 { |
|
384 my ($int, $len) = @_; |
|
385 return((defined($len) ? $len : ($len = ($int < 4294967296 ? 8 : 16))) < 9 ? sprintf("%0${len}X", $int) : |
|
386 sprintf("%0" . ($len - 8) . "X%08X", int($int / 4294967296), $int % 4294967296)); # 4294967296 = 4 G |
|
387 } |
|
388 |
|
389 sub Byte2Str($@) |
|
390 { |
|
391 my ($base, @byte) = @_; |
|
392 return(join("", map(($_ % 16 ? "" : sprintf("%04X:", $base + $_)) . sprintf(" %02X", $byte[$_]) . |
|
393 (!(($_ + 1) % 16) || ($_ == (@byte - 1)) ? "\n" : ""), (0 .. (@byte - 1))))); |
|
394 } |
|
395 |
|
396 sub Str2Byte($) |
|
397 { |
|
398 my ($str, $ind, @byte) = (shift(), 0, ()); |
|
399 $str =~ s/,$/, /; |
|
400 map { |
|
401 $ind++; |
|
402 s/^\s+|\s+$//g; |
|
403 if (/^\d+$/ && $_ < 256) { |
|
404 push(@byte, $_); |
|
405 } elsif (/^0x[0-9A-F]+$/i && hex() < 256) { |
|
406 push(@byte, hex()); |
|
407 } else { |
|
408 die("Invalid $ind. byte: `$_'.\n"); |
|
409 return; |
|
410 } |
|
411 } split(/,/, $str); |
|
412 return(@byte); |
|
413 } |
|
414 |
|
415 sub Str2Xml($) |
|
416 { |
|
417 my $str = shift(); |
|
418 $str =~ s/(.)/{'"'=>'"', '&'=>'&', "'"=>''', '<'=>'<', '>'=>'>'}->{$1} || $1/ge; |
|
419 return($str); |
|
420 } |
|
421 |
|
422 sub Ascii2Uni($) |
|
423 { |
|
424 (local $_ = shift()) =~ s/(?<!\r)\n/\r\n/g; # Use CR+LF newlines |
|
425 s/(.)/$1\x00/gs; |
|
426 return("\xFF\xFE$_"); |
|
427 } |
|
428 |
|
429 sub Uni2Ascii($) |
|
430 { |
|
431 (local $_ = shift()) =~ s/(.)\x00/$1/gs; |
|
432 s/\r\n/\n/g; |
|
433 return(substr($_, 2)); |
|
434 } |
|
435 |
|
436 sub GetTimestamp() |
|
437 { |
|
438 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = localtime(); |
|
439 return(sprintf("%04d%02d%02d%02d%02d%02d%02d", |
|
440 $year + 1900, $mon + 1, $mday, $hour, $min, $sec, int(($yday + ($year == 109 ? 3 : -3)) / 7) + 1)); |
|
441 } |
|
442 |
|
443 sub Sec2Min($) |
|
444 { |
|
445 my $sec = shift(); |
|
446 return(sprintf("%02d:%02d", $sec / 60, $sec % 60)); |
|
447 } |
|
448 |
|
449 sub Wcard2Restr($) |
|
450 { |
|
451 (my $wcard = shift()) =~ s/(.)/{"*"=>".*", "?"=>"."}->{$1} || "\Q$1\E"/ge; |
|
452 return($wcard); |
|
453 } |
|
454 |
|
455 sub Wcard2Regex($) |
|
456 { |
|
457 my $restr = Wcard2Restr(shift()); |
|
458 return(qr/$restr/i); |
|
459 } |
|
460 |
|
461 sub ParseCmdWords($) |
|
462 { |
|
463 my $line = Trim(shift()); |
|
464 $line =~ s/\\/\\\\/g if $gWinOS; |
|
465 return(Text::ParseWords::parse_line('\s+', 0, $line)); |
|
466 } |
|
467 |
|
468 |
|
469 ############################################################################### |
|
470 # |
|
471 |
|
472 sub DPrint($@) |
|
473 { |
|
474 my ($verbose, @outlist) = @_; |
|
475 map { tr/\x00\x1F/#/ } @outlist; |
|
476 print(@outlist) if !$verbose || ($verbose & $gVerbose); |
|
477 push(@gLogbuf, @outlist) if ($verbose < 32) || ($verbose & $gVerbose); |
|
478 return if ($gLogfile eq "" || !@gLogbuf); |
|
479 print(LOG @gLogbuf); |
|
480 @gLogbuf = (); |
|
481 } |
|
482 |
|
483 sub Echo($$$) |
|
484 { |
|
485 return if SkipICmd(); |
|
486 my ($verbose, $str) = (shift(), shift()); |
|
487 DPrint($verbose, shift() ? "$str\n" : Unquote($str)); |
|
488 } |
|
489 |
|
490 |
|
491 ############################################################################### |
|
492 # File operations |
|
493 |
|
494 sub PathConv($;$$$) |
|
495 { |
|
496 my $path = shift(); |
|
497 if (shift()) { $path =~ tr-\/-\\- } |
|
498 else { $path =~ tr-\\-\/- } |
|
499 return($path) if (!$gWinOS || $path =~ /^(?:\/\/|\\\\)/); |
|
500 my $drive = shift(); |
|
501 return(ucfirst(($path =~ /^[a-z]:/i ? "" : ($_[0] ? $_[0] : $gWorkdrive)) . $path)) |
|
502 if !$drive; |
|
503 $drive = $gWorkdrive if !($drive = shift()); |
|
504 $path =~ s/^$drive//i; |
|
505 return($path); |
|
506 } |
|
507 |
|
508 sub ParseFiles($) |
|
509 { |
|
510 my ($file, @files) = (" " . shift() . " ", ()); |
|
511 push(@files, defined($1) ? $1 : (defined($2) ? $2 : ())) while ($file =~ /\s(?:"\s*"|"+(.+?)"+|((\\\s|\S)+))(?=\s)/g); |
|
512 return(@files); |
|
513 } |
|
514 |
|
515 sub GlobFiles($;$) |
|
516 { |
|
517 return(@gFindresult) if (my $file = shift()) =~ /^__find__$/i; |
|
518 return(map(/[\*\?]/ ? sort({lc($a) cmp lc($b)} grep(!/[\/\\]\.\.?$/, |
|
519 glob(scalar(s/\*/\{\.\*\,\*\}/g, /\s/) ? "\"$_\"" : $_))) : $_, (shift() ? $file : ParseFiles($file)))); |
|
520 } |
|
521 |
|
522 sub GetBasename($) |
|
523 { |
|
524 return((File::Basename::fileparse(shift()))[0]); |
|
525 } |
|
526 |
|
527 sub GetDirname($) |
|
528 { |
|
529 (my $dir = shift()) =~ s/^>>?(?!>)//; |
|
530 return((File::Basename::fileparse($dir))[1]); |
|
531 } |
|
532 |
|
533 sub GetAbsDirname($;$$$) |
|
534 { |
|
535 (my $dir = shift()) =~ s/^>>?(?!>)//; |
|
536 $dir = "." if ($dir eq ""); |
|
537 my $absdir = ""; |
|
538 eval { local $gEvalerr = 1; $absdir = Cwd::abs_path($dir) }; |
|
539 return(PathConv($absdir || File::Spec->rel2abs($dir, |
|
540 $dir !~ /^$gWorkdrive/i && $dir =~ /^([a-z]:)/i ? "$1/" : ""), shift(), shift(), shift())); |
|
541 } |
|
542 |
|
543 sub GetAbsFname($;$$$) |
|
544 { |
|
545 my $file = shift(); |
|
546 return($file) if ($file eq "" || $file =~ /STD(IN|OUT|ERR)$/); |
|
547 my $append = ($file =~ s/^>>(?!>)// ? ">>" : ""); |
|
548 return($append . PathConv(File::Spec->catpath("", GetAbsDirname(GetDirname($file)), GetBasename($file)), shift(), shift(), shift())); |
|
549 } |
|
550 |
|
551 sub GetRelFname($;$$) |
|
552 { |
|
553 my ($file, $base) = (shift(), shift()); |
|
554 my $append = ($file =~ s/^>>(?!>)// ? ">>" : ""); |
|
555 ($file = PathConv(File::Spec->abs2rel($file, GetAbsDirname(defined($base) && ($base ne "") ? $base : ".")), |
|
556 shift(), 1, "[a-z]:")) =~ s/^[\/\\]+//; |
|
557 return("$append$file"); |
|
558 } |
|
559 |
|
560 sub GetWriteFname($) |
|
561 { |
|
562 (my $file = shift()) =~ s/^>?/>/; |
|
563 return($file); |
|
564 } |
|
565 |
|
566 sub GetFreeDrive(;$) |
|
567 { |
|
568 my $drives = Win32API::File::GetLogicalDrives(); |
|
569 for my $drive ("F".."Z", "A".."E") { |
|
570 return("$drive:") if !($drives & (2 ** (ord($drive) - ord("A")))); |
|
571 } |
|
572 return("") if shift(); |
|
573 die("GetFreeDrive: No free drive available.\n"); |
|
574 } |
|
575 |
|
576 sub SubstDrive($$) |
|
577 { |
|
578 my ($drive, $path) = (uc(shift()), GetAbsDirname(shift())); |
|
579 DPrint(16, "SubstDrive: `$drive' => `$path'\n"); |
|
580 $gSubstdrv{$drive} = 1, return if !(Win32API::File::GetLogicalDrives() & (2 ** (ord($drive) - ord("A")))) && |
|
581 Win32API::File::DefineDosDevice(0, $drive, $path); |
|
582 die("Can't substitute `$drive' => `$path'\n"); |
|
583 } |
|
584 |
|
585 sub UnsubstDrive($) |
|
586 { |
|
587 return if (my $drive = uc(shift())) eq ""; |
|
588 DPrint(16, "UnsubstDrive: `$drive'\n"); |
|
589 delete($gSubstdrv{$drive}), return if Win32API::File::DefineDosDevice(DDD_REMOVE_DEFINITION, $drive, []) && |
|
590 !(Win32API::File::GetLogicalDrives() & (2 ** (ord($drive) - ord("A")))); |
|
591 warn("Can't remove substituted drive `$drive'\n"); |
|
592 } |
|
593 |
|
594 sub Search($$$$$$\@\$) |
|
595 { |
|
596 my ($dir, $basere, $inclre, $exclre, $subdir, $finddir, $files, $total) = @_; |
|
597 my @dir = my @file = (); |
|
598 |
|
599 opendir(SDIR, $dir) or warn("Can't open directory `$dir'.\n"); |
|
600 while (local $_ = readdir(SDIR)) { |
|
601 next if ($_ eq ".") || ($_ eq ".."); |
|
602 push(@dir, $_) if ((my $isdir = !(my $isfile = -f($_ = "$dir/$_")) && -d()) && $subdir); |
|
603 next if ($finddir ? $isfile : $isdir); |
|
604 ++$$total; |
|
605 (my $fname = $_) =~ s/$basere//; |
|
606 push(@file, $_) if ($fname =~ /$inclre/) && ($fname !~ /$exclre/) && |
|
607 (($finddir != 2) || !@{[glob((/\s/ ? "\"$_\"" : $_) . "/{[^.],.[^.],.??*,*}")]}); |
|
608 } |
|
609 closedir(SDIR); |
|
610 push(@$files, sort({lc($a) cmp lc($b)} @file)); |
|
611 |
|
612 foreach (sort({lc($a) cmp lc($b)} @dir)) { |
|
613 Search($_, $basere, $inclre, $exclre, 1, $finddir, @$files, $$total); |
|
614 } |
|
615 } |
|
616 |
|
617 sub Find($$$$$\$) |
|
618 { |
|
619 my ($dur, $dir, $inclpat, $exclpat, $subdir, $finddir, $total) = (time(), @_); |
|
620 ($dir, $$total) = (GetAbsDirname($dir), 0); |
|
621 my ($inclre, $exclre, @files) = ("", "", ()); |
|
622 if ($inclpat =~ /^\//) { |
|
623 $inclre = eval("qr$inclpat"); |
|
624 $inclpat = ""; |
|
625 } else { |
|
626 $inclre = join("|", map(Wcard2Restr($_), split(/\s+/, $inclpat))); |
|
627 $inclre = qr/\/(?:$inclre)$/i; |
|
628 } |
|
629 if ($exclpat =~ /^\//) { |
|
630 $exclre = eval("qr$exclpat"); |
|
631 $exclpat = ""; |
|
632 } else { |
|
633 $exclre = join("|", map(Wcard2Restr($_), split(/\s+/, $exclpat))); |
|
634 $exclre = qr/\/(?:$exclre)$/i; |
|
635 } |
|
636 DPrint(16, "Find" . ($finddir == 2 ? "EmptyDir" : ($finddir ? "Dir" : "File")) . ": Directory `$dir'" . |
|
637 ($subdir ? " and subdirectories" : "") . ", pattern `" . ($inclpat ne "" ? "$inclpat' $inclre" : "$inclre'") . |
|
638 ($exclre eq qr/\/(?:)$/i ? "" : " excluding `" . ($exclpat ne "" ? "$exclpat' $exclre" : "$exclre'"))); |
|
639 foreach (GlobFiles($dir, 1)) { |
|
640 Search($_, qr/^$_/i, $inclre, $exclre, $subdir, $finddir, @files, $$total) if -d(); |
|
641 } |
|
642 DPrint(16, ", found " . @files . "/$$total " . ($finddir ? "directories" : "files") . |
|
643 ", duration: " . Sec2Min(time() - $dur) . "\n"); |
|
644 return(@files); |
|
645 } |
|
646 |
|
647 sub ChangeDir($) |
|
648 { |
|
649 if ((my $dir = GetAbsDirname(shift())) ne GetAbsDirname(".")) { |
|
650 DPrint(16, "ChangeDir: `$dir'\n"); |
|
651 chdir($dir) or die("Can't change to directory `$dir'.\n"); |
|
652 } |
|
653 } |
|
654 |
|
655 sub DeleteDir($;$) |
|
656 { |
|
657 return if !-d(my $dir = GetAbsDirname(shift())); |
|
658 DPrint(16, "DeleteDir: `$dir'\n"); |
|
659 for my $sec (0, 2, 5) { |
|
660 warn("Can't delete directory `$dir', retrying in $sec seconds...\n"), sleep($sec) if $sec; |
|
661 eval { local $gEvalerr = 1; File::Path::rmtree($dir) }; |
|
662 return if !-d($dir); |
|
663 RunSystemCmd($gWinOS ? 'rmdir /q /s "' . PathConv($dir, 1) . '"' : |
|
664 "rm -fr '$dir'", 2); |
|
665 sleep(1); |
|
666 return if !-d($dir); |
|
667 } |
|
668 $dir = "Can't delete directory `$dir'.\n"; |
|
669 shift() ? warn($dir) : die($dir); |
|
670 } |
|
671 |
|
672 sub FindDir($$$$) |
|
673 { |
|
674 my ($dir, $inclpat, $exclpat, $opt) = @_; |
|
675 $opt = "" if !defined($opt); |
|
676 push(@gFindresult, Find($dir, $inclpat, $exclpat, $opt =~ /r/, 1, local $_)); |
|
677 } |
|
678 |
|
679 sub MakeDir($) |
|
680 { |
|
681 return if -d(my $dir = shift()); |
|
682 eval { local $gEvalerr = 1; File::Path::mkpath($dir = GetAbsDirname($dir)) }; |
|
683 if (-d($dir)) { |
|
684 DPrint(16, "MakeDir: `" . GetAbsDirname($dir) ."'\n"); |
|
685 } else { |
|
686 DPrint(16, "MakeDir: `$dir'\n"); |
|
687 die("Can't create directory `$dir'.\n"); |
|
688 } |
|
689 } |
|
690 |
|
691 sub MakeChangeDir($) |
|
692 { |
|
693 MakeDir(my $dir = shift()); |
|
694 ChangeDir($dir); |
|
695 } |
|
696 |
|
697 sub SetWorkdir($) |
|
698 { |
|
699 MakeChangeDir(shift()); |
|
700 $gWorkdrive = (Cwd::cwd() =~ /^([a-z]:)/i ? uc($1) : ""); |
|
701 $gWorkdir = GetAbsDirname("."); |
|
702 } |
|
703 |
|
704 sub OpenFile(*$$;$) |
|
705 { |
|
706 my ($fhandle, $file, $binmode, $print) = @_; |
|
707 MakeDir(GetDirname($file)) if $file =~ /^>/; |
|
708 DPrint(16, defined($print) ? $print : ($file =~ /^>/ ? "Write" : "Read") . "File: `$file'\n"); |
|
709 return(open($fhandle, $file)) if !$binmode; |
|
710 return(open($fhandle, $file) and binmode($fhandle)); |
|
711 } |
|
712 |
|
713 sub Test($) |
|
714 { |
|
715 if (-d(my $file = shift())) { |
|
716 DPrint(16, "TestDir: `" . GetAbsDirname($file) . "'\n"); |
|
717 } elsif (-f($file)) { |
|
718 DPrint(16, "TestFile: `" . GetAbsFname($file) . "'\n"); |
|
719 } else { |
|
720 DPrint(16, "Test: `$file'\n"); |
|
721 die("File or directory `$file' doesn't exist.\n"); |
|
722 } |
|
723 } |
|
724 |
|
725 sub CutFile($$$$$) |
|
726 { |
|
727 my ($msg, $src, $dest, $head, $len) = @_; |
|
728 my ($buf, $srctmp) = (undef, "$src.tmp"); |
|
729 |
|
730 OpenFile(*INFILE, $src, 1, $msg) or |
|
731 die("Can't read file `$src'.\n"), return; |
|
732 |
|
733 my $out = GetWriteFname($head ? $dest : $srctmp); |
|
734 OpenFile(*OUTFILE, $out, 1) or die("Can't write to `$out'.\n"), return; |
|
735 while ($len > 0) { |
|
736 read(INFILE, $buf, $len < READBUFSIZE ? $len : READBUFSIZE); |
|
737 print(OUTFILE $buf); |
|
738 $len -= READBUFSIZE; |
|
739 } |
|
740 close(OUTFILE); |
|
741 |
|
742 $out = GetWriteFname($head ? $srctmp : $dest); |
|
743 OpenFile(*OUTFILE, $out, 1) or die("Can't write to `$out'.\n"), return; |
|
744 print(OUTFILE $buf) while read(INFILE, $buf, READBUFSIZE); |
|
745 close(OUTFILE); |
|
746 close(INFILE); |
|
747 Move($srctmp, $src); |
|
748 } |
|
749 |
|
750 sub Copy($$;$) |
|
751 { |
|
752 my ($src, $dest, $dir) = @_; |
|
753 $dir = defined($dir) && $dir; |
|
754 my $file = !($dir || -d($src)); |
|
755 $src = ($file ? GetAbsFname($src) : GetAbsDirname($src)); |
|
756 $dest = ($file ? GetAbsFname(-d($dest) ? "$dest/" . GetBasename($src) : $dest) : |
|
757 GetAbsDirname($dir ? $dest : "$dest/" . GetBasename($src))); |
|
758 if ($file && ($dest =~ /^>>[^>]/)) { |
|
759 OpenFile(*FILE, $dest, 1, "AppendFile: `$src' => `$dest'\n") |
|
760 or die("Can't append to `$dest'.\n"), return; |
|
761 File::Copy::copy($src, *FILE) and |
|
762 close(FILE) and return; |
|
763 } |
|
764 elsif ($file) { |
|
765 MakeDir(GetDirname($dest)); |
|
766 DPrint(16, "CopyFile: `$src' => `$dest'\n"); |
|
767 warn("CopyFile: Destination file `$dest' already exists\n") if -f($dest); |
|
768 File::Copy::copy($src, $dest) and return; |
|
769 } else { |
|
770 DPrint(16, "CopyDir: `$src' => `$dest'\n"); |
|
771 return if !RunSystemCmd(!$gWinOS ? "cp \"$src\"/* \"$dest\" -frv" : |
|
772 'xcopy "' . PathConv($src, 1) . '" "' . PathConv($dest, 1) . '" /e /h /i /q /y /z', 2); |
|
773 } |
|
774 die("Can't copy `$src' to `$dest'.\n"); |
|
775 } |
|
776 |
|
777 sub CopyIby($$) |
|
778 { |
|
779 my ($file, $dir) = (GetAbsFname(shift()), shift()); |
|
780 OpenFile(*FILE, $file, 0) or die("Can't read file `$file'.\n"), return; |
|
781 map { |
|
782 Copy(defined($1) ? $1 : $2, "$dir/" . (defined($3) ? $3 : $4)) if $_ =~ FILESPECSTATEMENT; |
|
783 } <FILE>; |
|
784 close(FILE); |
|
785 } |
|
786 |
|
787 sub DeleteFile($;$) |
|
788 { |
|
789 return if !-f(my $file = GetAbsFname(shift())); |
|
790 DPrint(16, "DeleteFile: `$file'\n"); |
|
791 for my $sec (0, 1, 2) { |
|
792 warn("Can't delete file `$file', retrying in $sec second(s)...\n"), sleep($sec) if $sec; |
|
793 unlink($file); |
|
794 return if !-f($file); |
|
795 } |
|
796 $file = "Can't delete file `$file'.\n"; |
|
797 shift() ? warn($file) : die($file); |
|
798 } |
|
799 |
|
800 sub FindFile($$$$) |
|
801 { |
|
802 my ($dir, $inclpat, $exclpat, $opt) = @_; |
|
803 $opt = "" if !defined($opt); |
|
804 my @find = Find($opt !~ /f/ ? $dir : GetDirname($dir), $opt !~ /f/ ? $inclpat : GetBasename($dir), |
|
805 $exclpat, $opt =~ /r/, 0, local $_); |
|
806 push(@gFindresult, $opt !~ /f/ ? @find : map("|$_|$inclpat", @find)); |
|
807 } |
|
808 |
|
809 sub HeadFile($$$) |
|
810 { |
|
811 my ($src, $dest, $len) = (GetAbsFname(shift()), GetAbsFname(shift()), shift()); |
|
812 $len = hex($len) if $len =~ /^0x/; |
|
813 CutFile("HeadFile: Cut first $len bytes from `$src' => `$dest'\n", $src, $dest, 1, $len); |
|
814 } |
|
815 |
|
816 sub TailFile($$$) |
|
817 { |
|
818 my ($src, $dest, $len) = (GetAbsFname(shift()), GetAbsFname(shift()), shift()); |
|
819 $len = hex($len) if $len =~ /^0x/; |
|
820 CutFile("TailFile: Cut last $len bytes from `$src' => `$dest'\n", $src, $dest, 0, (-s($src) ? -s($src) : 0) - $len); |
|
821 } |
|
822 |
|
823 sub TypeFile($;$) |
|
824 { |
|
825 my ($file, $str, $mode) = (GetAbsFname(shift()), "", shift() || ""); |
|
826 OpenFile(*FILE, $file, $mode, "TypeFile: `$file'" . |
|
827 ($gOutfilter && ($mode ne "b") ? ", filter: `/$gOutfilter/i'" : "") . "\n") or |
|
828 die("Can't read file `$file'.\n"), return; |
|
829 DPrint(8, STARTSTR . "\n"); |
|
830 read(FILE, $str, -s($file)); |
|
831 if ($mode eq "b") { |
|
832 DPrint(1, Byte2Str(0, map(ord(), split(//, $str)))); |
|
833 } else { |
|
834 $str = Uni2Ascii($str) if $mode eq "u"; |
|
835 DPrint(1, map("$_\n", grep(!$gOutfilter || /$gOutfilter/i, split(/\n/, $str)))); |
|
836 $gOutfilter = ""; |
|
837 } |
|
838 DPrint(8, ENDSTR . "\n"); |
|
839 close(FILE); |
|
840 } |
|
841 |
|
842 sub ReadFile($$) |
|
843 { |
|
844 my ($file, $warn) = (GetAbsFname(shift()), shift()); |
|
845 OpenFile(*RFILE, $file, 0) or |
|
846 ($warn ? (warn("Can't read file `$file'.\n"), return(())) : die("Can't read file `$file'.\n")); |
|
847 my @file = map(chomp() ? $_ : $_, grep(!/^\s*$/, <RFILE>)); |
|
848 close(RFILE); |
|
849 return(@file); |
|
850 } |
|
851 |
|
852 sub WriteFile($$$;$$) |
|
853 { |
|
854 my ($file, $str, $mode, $opt) = (GetAbsFname(shift()), shift(), shift() || "", shift()); |
|
855 OpenFile(*WFILE, GetWriteFname($file), $mode) or |
|
856 die("Can't write to `$file'.\n"), return; |
|
857 if ($mode eq "b") { |
|
858 my @byte = Str2Byte($str); |
|
859 DPrint(64, Byte2Str($file =~ s/^>>(?!>)// ? -s($file) : 0, @byte)); |
|
860 print(WFILE map(chr(), @byte)); |
|
861 } else { |
|
862 $opt = "" if !defined($opt); |
|
863 $str = Unquote($str) if ($opt !~ /q/); |
|
864 $str =~ s/(?<=\S)\/\//\//g if ($opt =~ /c/); |
|
865 DPrint(16, $str) if shift(); |
|
866 $str = Ascii2Uni($str) if ($mode eq "u"); |
|
867 print(WFILE $str); |
|
868 } |
|
869 close(WFILE); |
|
870 } |
|
871 |
|
872 sub UnzipFile($$) |
|
873 { |
|
874 my ($zipfile, $dir) = (GetAbsFname(shift()), GetAbsDirname(shift())); |
|
875 DPrint(16, "UnzipFile: `$zipfile'"); |
|
876 Archive::Zip::setErrorHandler(sub{}); |
|
877 my ($error, $zip) = (0, Archive::Zip->new()); |
|
878 if ($zip->read($zipfile) != AZ_OK) { |
|
879 DPrint(16, " to directory `$dir'\n"); |
|
880 die("Can't read zip archive `$zipfile'.\n"); |
|
881 return; |
|
882 } |
|
883 my @files = map($_->fileName(), grep(!$_->isDirectory(), $zip->members())); |
|
884 DPrint(16, ", " . @files . " files to directory `$dir'\n"); |
|
885 foreach my $file (@files) { |
|
886 DPrint(16, "ExtractFile: `$dir/$file'"); |
|
887 eval { local $gEvalerr = 1; $error = ($zip->extractMember($file, "$dir/$file") != AZ_OK) }; |
|
888 DPrint(16, $error ? " Failed\n" : "\n"); |
|
889 die("Can't extract file `$file' to directory `$dir'.\n") if $error; |
|
890 $error = 0; |
|
891 } |
|
892 } |
|
893 |
|
894 sub Zip($$$$@) |
|
895 { |
|
896 my ($zipfile, $dir, $opt, $prefix) = (GetAbsFname(shift()), shift(), shift(), shift()); |
|
897 |
|
898 $opt = (defined($opt) ? ", options: `$opt'" : ""); |
|
899 $prefix = GetAbsDirname($prefix) if $prefix ne ""; |
|
900 my %files = (); |
|
901 foreach my $file (@_) { |
|
902 my $zname = ""; |
|
903 ($file, $zname) = ($1, $2) if ($file =~ /^\|(.*)\|(.*)$/); |
|
904 next if !($file = (!$dir ? (-f($file) ? GetAbsFname($file) : "") : (-d($file) ? GetAbsDirname($file) : ""))); |
|
905 ($zname = ($zname eq "" ? $file : (!$dir ? |
|
906 GetAbsFname($zname) : GetAbsDirname($zname)))) =~ s/^(?:$gEpocroot|[a-z]:)?\/+//i; |
|
907 if ($opt !~ /j/) { |
|
908 $zname =~ s/^.*?\/+/$prefix\// if ($prefix ne ""); |
|
909 } else { |
|
910 $zname = ($dir ? "" : GetBasename($file)) if ($prefix eq "") || !s/^$prefix//; |
|
911 } |
|
912 $files{lc($zname)} = [$file, $zname]; |
|
913 } |
|
914 |
|
915 DPrint(16, ($dir ? "ZipDir: `$zipfile'$opt, " . keys(%files) . " directories" : |
|
916 "ZipFile: `$zipfile'$opt, " . keys(%files) . " files") . ($prefix ? ", prefix: $prefix\n" : "\n")); |
|
917 |
|
918 Archive::Zip::setErrorHandler(sub{}); |
|
919 my ($error, $zip) = (0, Archive::Zip->new()); |
|
920 $zip->read($zipfile) if (my $ziptmp = ($zipfile =~ s/^>>(?!>)// ? "$zipfile.tmp" : "")); |
|
921 $zip->zipfileComment("iMaker-generated zip archive `$zipfile'$opt."); |
|
922 |
|
923 foreach my $file (sort({lc($$a[0]) cmp lc($$b[0])} values(%files))) { |
|
924 DPrint(16, "Add" . ($dir ? "Dir" : "File") . ": `$$file[0]' => `$$file[1]'") if ($opt !~ /q/); |
|
925 eval { |
|
926 my $warn = 0; |
|
927 local $gEvalerr = 1; local $SIG{__WARN__} = sub{ $warn = 1 }; |
|
928 $error = ($dir ? $zip->addTree($$file[0], $$file[1]) != AZ_OK : |
|
929 !$zip->addFile($$file[0], $$file[1])) || $warn; |
|
930 }; |
|
931 DPrint(16, $error ? " Failed\n" : "\n") if ($opt !~ /q/); |
|
932 warn("Can't add " . ($dir ? "directory tree" : "file") . "`$$file[0]' to zip archive `$zipfile'.\n") if $error; |
|
933 $error = 0; |
|
934 } |
|
935 ($zip->writeToFileNamed($ziptmp ? $ziptmp : $zipfile) == AZ_OK) or |
|
936 die("Can't create zip archive `$zipfile'.\n"); |
|
937 Move($ziptmp, $zipfile) if $ziptmp; |
|
938 } |
|
939 |
|
940 sub Move($$) |
|
941 { |
|
942 my ($src, $dest) = @_; |
|
943 my $dir = -d($src); |
|
944 $src = ($dir ? GetAbsDirname($src) : GetAbsFname($src)); |
|
945 MakeDir(GetDirname($dest)); |
|
946 $dest = ($dir ? GetAbsDirname($dest) : GetAbsFname($dest)); |
|
947 DPrint(16, "Move" . ($dir ? "Dir" : "File") . ": `$src' => `$dest'\n"); |
|
948 File::Copy::move($src, $dest) or |
|
949 die("Can't move `$src' to `$dest'.\n"); |
|
950 } |
|
951 |
|
952 sub Touch($@) |
|
953 { |
|
954 my $time = (shift() =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/ ? |
|
955 Time::Local::timelocal($6, $5, $4, $3, $2 - 1, $1 - 1900) : time); |
|
956 if (@_ != 1) { |
|
957 DPrint(16, "Touch: " . scalar(@_) . " files/dirs, " . |
|
958 POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime($time)) . "\n"); |
|
959 utime($time, $time, @_) == @_ or |
|
960 die("Can't touch all the " . scalar(@_) . " files/dirs.\n"); |
|
961 return; |
|
962 } |
|
963 my $file = shift(); |
|
964 my $dir = -d($file); |
|
965 $file = ($dir ? GetAbsDirname($file) : GetAbsFname($file)); |
|
966 DPrint(16, "Touch" . ($dir ? "Dir" : "File") . ": `$file', " . |
|
967 POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime($time)) . "\n"); |
|
968 utime($time, $time, $file) == 1 or |
|
969 die("Can't touch " . ($dir ? "directory" : "file") . " `$file'.\n"); |
|
970 } |
|
971 |
|
972 sub SetLogfile($) |
|
973 { |
|
974 return if !(my $file = GetAbsFname(shift())); |
|
975 my $append = (($file =~ s/^>>(?!>)//) || exists($gLogfiles{$file}) ? ">>" : ""); |
|
976 CloseLog(); |
|
977 OpenFile(*LOG, GetWriteFname($file = "$append$file"), 0) or |
|
978 warn("Can't log to file `$file'.\n"), return; |
|
979 $gLogfiles{$gLogfiles{__prev__} = $gLogfile = $file} = 1; |
|
980 } |
|
981 |
|
982 |
|
983 ############################################################################### |
|
984 # |
|
985 |
|
986 sub RunSystemCmd($;$$$) |
|
987 { |
|
988 return if ($gICmd !~ $gFiltercmd); |
|
989 my ($cmd, $keepgoing, $null, $file) = @_; |
|
990 DPrint(1, "$cmd\n"), return if $gPrintcmd; |
|
991 local $gError = 0 if ($keepgoing = (defined($keepgoing) && ($keepgoing =~ /^[123]$/) ? $keepgoing : 0)); |
|
992 local $gKeepgoing = Max($gKeepgoing, $keepgoing) if $keepgoing; |
|
993 $file = (defined($file) ? GetAbsFname($file) : ""); |
|
994 @gCmdoutbuf = (); |
|
995 DPrint(4, local $_ = "RunSystemCmd(" . GetAbsDirname(".") . "): `$cmd'" . |
|
996 ($keepgoing ? ", keep going" . ($keepgoing > 1 ? "($keepgoing)" : "") : "") . |
|
997 ($file ? ", redirect to `$file'" : "") . ($null ? ", redirect stdout to null" : "") . |
|
998 ($gOutfilter ? ", filter: `/$gOutfilter/i'" : "") . "\n"); |
|
999 OpenFile(*CMDFILE, GetWriteFname($file), 0) or |
|
1000 (die("Can't write to `$file'.\n"), $file = "") if $file; |
|
1001 print(CMDFILE $_) if $file; |
|
1002 my $dur = time(); |
|
1003 open(CMD, "$cmd 2>&1 |"); |
|
1004 DPrint(8, STARTSTR . "\n"); |
|
1005 while ($_ = <CMD>) { |
|
1006 chomp(); |
|
1007 push(@gCmdoutbuf, $_); |
|
1008 next if ($gOutfilter && !/$gOutfilter/i); |
|
1009 DPrint(8, "$_\n") if !$null; |
|
1010 print(CMDFILE "$_\n") if $file; |
|
1011 } |
|
1012 close(CMD); |
|
1013 my $error = ($? >> 8); |
|
1014 close(CMDFILE) if $file; |
|
1015 push(@gStepDur, $dur = time() - $dur); |
|
1016 $gOutfilter = ""; |
|
1017 print(map("$_\n", @gCmdoutbuf)) if ($error && !$gKeepgoing && !$null && $gVerbose && !($gVerbose & 8)); |
|
1018 $dur = Sec2Min($dur); |
|
1019 DPrint(8, substr(ENDSTR, 0, -16) . $dur . substr(ENDSTR, length($dur) - 16) . "\n"); |
|
1020 die("Command `$cmd' failed ($error) in `" . GetAbsDirname(".") . "'.\n") if $error; |
|
1021 return($error); |
|
1022 } |
|
1023 |
|
1024 |
|
1025 ############################################################################### |
|
1026 # |
|
1027 |
|
1028 sub ParseSystemCmd($$$$$) |
|
1029 { |
|
1030 return if SkipICmd(); |
|
1031 my ($title, $inclre, $exclre, $file, $lines) = @_; |
|
1032 ($inclre, $exclre) = (eval("qr$inclre"), $exclre ne "" ? eval("qr$exclre") : qr/^$/); |
|
1033 $lines = ($lines ? $lines - 1 : 0); |
|
1034 |
|
1035 my @parse = (); |
|
1036 for (my $i = 0; $i < @gCmdoutbuf; $i++) { |
|
1037 next if ($gCmdoutbuf[$i] !~ $inclre); |
|
1038 push(@parse, join(" | ", @gCmdoutbuf[$i .. $i + $lines])) if ($gCmdoutbuf[$i] !~ $exclre); |
|
1039 $i += $lines; |
|
1040 } |
|
1041 return if !@parse; |
|
1042 if (!$file) { |
|
1043 DPrint(1, "$title\n", map(sprintf("%" . length(@parse) . "s", $_) . ") $parse[$_ - 1]\n", 1 .. @parse)); |
|
1044 } else { |
|
1045 WriteFile($title, join("\n", @parse), "", "q"); |
|
1046 } |
|
1047 } |
|
1048 |
|
1049 |
|
1050 ############################################################################### |
|
1051 # |
|
1052 |
|
1053 sub GenExclfile($$$$$) |
|
1054 { |
|
1055 return if SkipICmd(); |
|
1056 |
|
1057 my ($exclfile, $base, $prefix, $exclfiles, @exclfiles) = (shift(), GetAbsDirname(shift()), shift(), "", ()); |
|
1058 |
|
1059 if (!-f($exclfile)) { |
|
1060 WriteFile($exclfile, "", ""); |
|
1061 } else { |
|
1062 OpenFile(*FILE, $exclfile, 1) or die("Can't read file `$exclfile'.\n"), return; |
|
1063 read(FILE, $exclfiles, -s($exclfile)); |
61 close(FILE); |
1064 close(FILE); |
62 $version and print("$version\n") or |
1065 @exclfiles = split(/\n/, Uni2Ascii($exclfiles)); |
63 warn("Can't read iMaker version from `$verfile'.\n"); |
1066 } |
64 |
1067 |
65 my $cmdarg = " " . imaker::HandleCmdArg($ENV{IMAKER_CMDARG}) . " "; |
1068 my $findfiles = 0; |
66 my $makecmd = "$ENV{IMAKER_MAKE} -R --no-print-directory" . |
1069 my @addfiles = map($_ ne "**" ? $_ : "*", grep(!(($_ eq "*") && ++$findfiles), |
67 ($ENV{IMAKER_MAKESHELL} ? " SHELL=\"$ENV{IMAKER_MAKESHELL}\"" : ""); |
1070 map(Trim(Unquote(Trim($_))), grep(!/^\s*(?:#.*)?$/, split(/(?<!\\)\\n/, shift()))))); |
68 my $cmdout = qx($makecmd -f $0 $cmdarg 2>&1); |
1071 |
69 my $targets = ($cmdout =~ />>>MAKECMDGOALS=(.*?)<<</ ? $1 : undef); |
1072 if ($findfiles) { |
70 |
1073 $exclfiles = ""; |
71 die("Can't run `$ENV{IMAKER_MAKE}' properly:\n$cmdout") if !defined($targets); |
1074 foreach (@exclfiles, @addfiles, map(Trim(Unquote(Trim($_))), grep(!/^\s*(?:#.*)?$/, split(/(?<!\\)\\n/, shift())))) { |
72 map { $cmdarg =~ s/\s+\Q$_\E\s+/ / } split(/\s+/, $targets); |
1075 (my $file = $_) =~ tr/\\/\//; |
73 |
1076 $file =~ s/^(?:[a-z]:)?\/*//i; |
74 my $tmptarg = $targets = " $targets"; |
1077 $exclfiles .= ($exclfiles ne "" ? "|" : "") . Wcard2Restr($file); |
75 my $hptarg = 0; |
1078 } |
76 while ($tmptarg =~ /(\s+(help-\S+))/g) { |
1079 push(@addfiles, map(GetRelFname($_, $base), Find($base, "*", "/^\\/(?:$exclfiles)\$/i", 1, 0, local $_))); |
77 $hptarg = $1, $targets =~ s/\Q$hptarg\E(.*)$/ $1$hptarg/ if $2 ne "help-config"; |
1080 } |
78 } |
1081 |
79 $hptarg = $1, $targets =~ s/\Q$hptarg\E(.*)$/ $1$hptarg/ while $tmptarg =~ /(\s+print-\S+)/g; |
1082 $prefix =~ s/[\/\\]+$//; |
80 $targets =~ s/^\s+|\s+(?=\s)|\s$//g; |
1083 WriteFile($exclfile, join("", map("$_\n", @exclfiles, |
81 |
1084 map(s/^(?:[a-z]:)?\\*/$prefix\\/i ? $_ : $_, map(tr/\//\\/ ? $_ : $_, @addfiles)))), "u", "q"); |
82 my $mainmk = "-f $ENV{IMAKER_DIR}/imaker.mk"; |
1085 } |
83 $makecmd .= " -I " . imaker::GetAbsDirname($ENV{CONFIGROOT}, 0, 1) . " $mainmk"; |
1086 |
84 |
1087 sub GenIbyfile($$$) |
85 foreach my $target ($hptarg || $targets eq "" ? $targets : split(/\s/, $targets)) { |
1088 { |
86 ($cmdarg, $target) = imaker::Menu($makecmd, $mainmk, $cmdarg) if $target eq "menu"; |
1089 return if SkipICmd(); |
87 system($ENV{IMAKER_MAKECMD} = "$makecmd TIMESTAMP=" . imaker::GetTimestamp() . " $cmdarg $mainmk $target") |
1090 my ($ibyfile, $ibystr, $oride, $prevoride) = (shift(), "", "", ""); |
88 if $target ne "menu"; |
1091 |
89 $error = ($? >> 8) if ($? >> 8); |
1092 map { |
90 } |
1093 die("GenIbyfile: Invalid file list configuration: `$_'\n"), return |
91 |
1094 if !/^\s*(?:"(.+?)"|(\S+))\s+(?:"(.+?)"|(\S+))\s*$/; |
92 # imaker::DPrint(1, "\nTotal duration: " . imaker::Sec2Min(time() - $start) . "\n"); |
1095 $_ = [defined($1) ? $1 : $2, defined($3) ? $3 : $4]; |
93 exit($error || 0); |
1096 } (my @files = map(Unquote($_), grep(!/^\s*(?:#.*)?$/, split(/(?<!\\)\\n/, shift())))); |
94 } |
1097 |
95 |
1098 my @ibyconf = map(Unquote($_), grep(!/^\s*(?:#.*)?$/, split(/(?<!\\)\\n/, shift()))); |
96 #========================================================================== |
1099 |
97 |
1100 foreach (@ibyconf) { |
98 my ($opt_cmdfile, $opt_incdir, $opt_logfile, $opt_printcmd, $opt_step, $opt_verbose, $opt_workdir) = |
1101 die("GenIbyfile: Invalid configuration: `$_'\n"), return |
99 ( "", "", "", 0, "", 1, "."); |
1102 if !/^\s*(?:"(.+?)"|(\S+))\s+(hide|remove|(?:replace|udeb|urel)(?:-add)?)\s+(\*|core|rofs[2-6])\s*$/i; |
100 Getopt::Long::GetOptions( |
1103 next if ($4 ne "*") && (uc($4) ne $gImgtype); |
101 "cmdfile=s" => \$opt_cmdfile, |
1104 my $action = lc($3); |
102 "incdir=s" => \$opt_incdir, |
1105 my $file = Wcard2Restr(defined($1) ? $1 : $2); |
103 "logfile=s" => \$opt_logfile, |
1106 $file = qr/(?:^|\\|\/)$file$/i; |
104 "printcmd" => \$opt_printcmd, |
1107 foreach (@files) { |
105 "step=s" => \$opt_step, |
1108 next if (@$_[1] !~ $file); |
106 "verbose=s" => \$opt_verbose, |
1109 $oride = ($action =~ /add$/ ? "ADD" : ($action eq "hide" ? "" : "SKIP")); |
107 "workdir=s" => \$opt_workdir, |
1110 my $src = ($action eq "remove" ? "empty" : @$_[0]); |
108 "<>" => sub { $error .= ($error ? ", `@_'" : "Unknown imaker.pl option: `@_'") }); |
1111 if ($action =~ /^udeb/) { |
109 |
1112 $src =~ s/(?<=[\/\\])urel(?=[\/\\])/udeb/i; |
110 if ($opt_incdir) { |
1113 } elsif ($action =~ /^urel/) { |
111 my $bsf = ($opt_incdir =~ s/:bsf$//); |
1114 $src =~ s/(?<=[\/\\])udeb(?=[\/\\])/urel/i; |
112 print(map("$_\n", imaker::GetFeatvarIncdir($opt_incdir, $bsf))); |
1115 } |
113 exit; |
1116 $ibystr .= ($prevoride && ($oride ne $prevoride) ? "OVERRIDE_END\n" : "") . |
114 } |
1117 ($oride && ($oride ne $prevoride) ? "OVERRIDE_REPLACE/$oride\n" : "") . |
115 |
1118 ($oride ? "override=\"$src\" " : "hide=") . "\"@$_[1]\"\n"; |
116 $opt_verbose = imaker::SetVerbose($opt_verbose); |
1119 $prevoride = $oride; |
117 |
1120 } |
118 imaker::DPrint(2, "=" x 79 . "\nTIME: " . localtime() . ", USER: " . getlogin() . |
1121 } |
119 ", HOST: " . ($ENV{HOSTNAME} || $ENV{COMPUTERNAME} || "?") . "\n$^X (v$perlver-$^O)\n"); |
1122 WriteFile($ibyfile, ($ibyfile =~ /^>>([^>].*)$/ && -f($1) ? "" : "// Generated `$ibyfile'") . |
120 |
1123 "\n\n/* Custom override configuration\n" . join("\n", @ibyconf) . "\n*/\n$ibystr" . |
121 imaker::SetLogfile($opt_logfile); |
1124 ($oride ? "OVERRIDE_END\n" : ""), "", "q"); |
122 die("$error.\n") if $error; |
1125 } |
123 |
1126 |
124 foreach (split(/-+/, $opt_step)) { |
1127 sub GenObyfile($$$$@) |
125 $error .= ($error ? ", `$_'" : "Unknown imaker.pl step: `$_'") |
1128 { |
126 if (!/^\w+:?([cbk\d]+)?$/i) || $1 && ($1 =~ /c.*c|b.*b|k.*k|\d[^\d]+\d/i); |
1129 return if SkipICmd(); |
127 } |
1130 |
128 die("$error.\n") if $error; |
1131 my ($ibyfile, $srcdir, $subdir, $finddir) = (GetAbsFname(shift()), shift(), shift(), shift()); |
129 |
1132 my ($header, $footer, $body, %files) = ("", "", "", ()); |
130 imaker::SetWorkdir($opt_workdir); |
1133 |
131 imaker::ReadICmdFile($opt_cmdfile); |
1134 foreach my $dir (split(/\s+/, $srcdir)) { |
132 |
1135 $dir = GetAbsDirname($dir); |
133 my (@step, @stepdur) = (split(/-+/, lc($opt_step)), ()); |
1136 my ($found, $total, $lines) = (0, 0, ""); |
134 my ($durstr, $maxslen, $maxdlen) = ("", 6, 8); |
1137 my @param = @_; |
135 |
1138 while (@param) { |
136 foreach my $stepnum (0 .. $#step) { |
1139 my ($filepat, $format, @lines) = (shift(@param), shift(@param), ()); |
137 $step[$stepnum] =~ /^(\w+):?([cbk\d]+)?$/; |
1140 $header = $format, next if $filepat =~ /^__header__$/i; |
138 my $step = uc($1); |
1141 $footer = $format, next if $filepat =~ /^__footer__$/i; |
139 $_ = (defined($2) ? $2 : ""); |
1142 foreach my $src (Find($dir, $filepat, "", $subdir, $finddir, $total)) { |
140 my @dur = imaker::MakeStep($step, /c/, /b/, /k/, /(\d+)/ ? $1 : $opt_verbose, $opt_printcmd); |
1143 next if $files{$src}; |
141 imaker::SetVerbose($opt_verbose); |
1144 $files{$src} = 1; |
142 my ($cmddur, $stepdur) = (0, pop(@dur)); |
1145 (my $line = $format) =~ s/%1/$src/g; |
143 $durstr = imaker::Sec2Min($stepdur); |
1146 $line =~ s/%2/GetRelFname($src, $dir, 1)/ge; |
144 if (@dur) { |
1147 $line =~ s/%3/GetAbsFname($src)/ge; |
145 $durstr .= " ("; |
1148 if ($line =~ /%4/) { |
146 foreach my $dur (@dur) { |
1149 my $attrib = ""; |
147 $cmddur += $dur; |
1150 if ($gWinOS) { |
148 $durstr .= imaker::Sec2Min($dur) . " + "; |
1151 Win32::File::GetAttributes($src, $attrib); |
149 } |
1152 $attrib = (($attrib & WIN32_FILE_HIDDEN) ? "attrib=H" : ""); |
150 $durstr .= imaker::Sec2Min($stepdur - $cmddur) . ")"; |
1153 } |
151 } |
1154 $line =~ s/%4/$attrib/ge; |
152 $step = sprintf("%" . length(@step."") . "s", $stepnum + 1) . ". $step"; |
1155 } |
153 push(@stepdur, $step, $durstr); |
1156 push(@lines, Trim($line)); |
154 $maxslen = imaker::Max($maxslen, length($step)); |
1157 } |
155 $maxdlen = imaker::Max($maxdlen, length($durstr)); |
1158 $found += @lines; |
156 } |
1159 $lines .= "//\n// Format: `$format', " . @lines . ($finddir ? " empty directories" : " files") . |
157 |
1160 ": `$filepat'\n" . (@lines ? "//\n" . join("\n", @lines) . "\n" : ""); |
158 imaker::DPrint(2, "=" x 79 . "\n"); |
1161 } |
159 @stepdur = ("Step", "Duration", "=" x $maxslen, "=" x $maxdlen, @stepdur, |
1162 $body .= "\n// Collected entries $found/$total from directory `$dir'" . |
160 "-" x $maxslen, "-" x $maxdlen, "Total", imaker::Sec2Min(time() - $start)); |
1163 ($subdir ? " and subdirectories" : "") . "\n$lines"; |
161 imaker::DPrint(2, sprintf("%-${maxslen}s %-${maxdlen}s ", shift(@stepdur), shift(@stepdur)) . "\n") |
1164 } |
162 while(@stepdur); |
1165 |
163 |
1166 my $append = ($ibyfile =~ s/^>>(?!>)// && -f($ibyfile) && ">>" || ""); |
164 imaker::CloseLog(); |
1167 (my $fname = "__" . uc(GetBasename($ibyfile)) . "__") =~ s/\W/_/g; |
165 } |
1168 my @previby = (); |
|
1169 |
|
1170 if ($append) { |
|
1171 OpenFile(*FILE, $ibyfile, 0) or die("Can't read file `$ibyfile'.\n"), return; |
|
1172 @previby = <FILE>; |
|
1173 close(FILE); |
|
1174 $previby[0] =~ s/(, collected )(\d+)( entries)$/$1.($2 + keys(%files)).$3/e; |
|
1175 $previby[@previby - 1] = ""; |
|
1176 } |
|
1177 WriteFile($ibyfile, join("", @previby) . ($append ? "// Appended" : "// Generated") . |
|
1178 " `$append$ibyfile', collected " . keys(%files) . " entries\n" . |
|
1179 ($append ? "" : "\n#ifndef $fname\n#define $fname\n") . |
|
1180 ($header ? Unquote("\\n$header\\n") : "") . $body . ($footer ? Unquote("\\n$footer\\n") : "") . |
|
1181 "\n#endif // $fname\n", "", "q"); |
|
1182 } |
|
1183 |
|
1184 sub GenWidgetConf($$$$) |
|
1185 { |
|
1186 return if SkipICmd(); |
|
1187 my ($wgzini, $ini, $dir) = (shift(), GetAbsFname(shift()), GetAbsDirname(shift())); |
|
1188 my @ini = ($ini eq "" ? () : ReadFile($ini, 0)); |
|
1189 my $files = ($dir eq "" ? "" : join("\n", Find($dir, "*", '/\/(?:' . join("|", |
|
1190 map(GetBasename($_), ($ini, map(!/^\s*[#[]/ && /^\s*(?:"(.+?)"|(\S+))/ && |
|
1191 -e(local $_ = (defined($1) ? $1 : $2)) ? $_ : (), @ini)))) . ')$/i', 0, 0, local $_))); |
|
1192 |
|
1193 WriteFile($wgzini, Unquote(shift()) . |
|
1194 (@ini ? "# Copied lines from `$ini':\n" . join("\n", @ini) : "") . "\n" . |
|
1195 ($files ? (@ini ? "\n" : "") . "# Collected files from `$dir':\n$files\n" : ""), "", "q"); |
|
1196 } |
|
1197 |
|
1198 |
|
1199 ############################################################################### |
|
1200 # |
|
1201 |
|
1202 sub GenMakefile($$$$$) |
|
1203 { |
|
1204 return if SkipICmd(); |
|
1205 my ($hdrfile, $mkfile, $filter, $prepros, $assignop) = |
|
1206 (GetAbsFname(shift()), GetAbsFname(shift()), shift(), shift(), shift()); |
|
1207 ChangeDir(GetDirname($hdrfile)); |
|
1208 RunSystemCmd("$prepros " . GetBasename($hdrfile)); |
|
1209 my $maxdef = Max(map(/^\s*\#define\s+($filter)/ && length($1), @gCmdoutbuf)); |
|
1210 WriteFile($mkfile, join('\n', |
|
1211 map(/^\s*\#define\s+($filter)\s*(.*?)\s*$/ ? sprintf("%-${maxdef}s $assignop %s", $1, $2 eq "" ? 1 : $2) : (), sort(@gCmdoutbuf))) . '\n', ""); |
|
1212 } |
|
1213 |
|
1214 |
|
1215 ############################################################################### |
|
1216 # |
|
1217 |
|
1218 sub AddImageHeader($$$$$) |
|
1219 { |
|
1220 return if SkipICmd(); |
|
1221 my ($file, $hdrfile, $hdrstr, $hdrsize, $align) = |
|
1222 (GetAbsFname(shift()), GetAbsFname(shift()), shift(), shift(), shift()); |
|
1223 |
|
1224 $hdrstr =~ s/\/\*.*?\*\///g; |
|
1225 $hdrstr =~ s/,\s*$//; |
|
1226 WriteFile($hdrfile, $hdrstr, "b"); |
|
1227 die("Invalid image header size: " . sprintf("0x%X", -s($hdrfile)) . " (!=$hdrsize).\n"), return |
|
1228 if -s($hdrfile) ne hex($hdrsize); |
|
1229 |
|
1230 $align = Max(hex($align), hex($hdrsize)) - hex($hdrsize); |
|
1231 WriteFile(">>$hdrfile", ("0," x ($align - 1)) . "0", "b") if $align; |
|
1232 Copy($file, ">>$hdrfile") if $file ne ""; |
|
1233 } |
|
1234 |
|
1235 |
|
1236 ############################################################################### |
|
1237 # |
|
1238 |
|
1239 sub Sleep($) |
|
1240 { |
|
1241 return if SkipICmd(); |
|
1242 sleep(shift()); |
|
1243 } |
|
1244 |
|
1245 |
|
1246 ############################################################################### |
|
1247 # |
|
1248 |
|
1249 sub FindSOSFiles($$$$) |
|
1250 { |
|
1251 return if SkipICmd(); |
|
1252 |
|
1253 my ($dirs, $imgoby, $pluglog, $opt) = @_; |
|
1254 my ($file, %files) = ("", ()); |
|
1255 local $_; |
|
1256 |
|
1257 foreach my $dir (GlobFiles($dirs)) { |
|
1258 my ($featvar, @pluglog) = ("", Find($dir = GetAbsDirname($dir), $pluglog, "", 1, 0, $_)); |
|
1259 |
|
1260 foreach $file (@pluglog) { |
|
1261 OpenFile(*FILE, $file, 0) or warn("Can't read file `$file'.\n"), last; |
|
1262 while (<FILE>) { |
|
1263 last if !/^.+?\.pm: Initializing; /; |
|
1264 $featvar = $1, last if / feature variant = `(.+)'$/; |
|
1265 } |
|
1266 close(FILE); |
|
1267 last if ($featvar ne ""); |
|
1268 } |
|
1269 |
|
1270 foreach $file (Find($dir, $imgoby, "", 1, 0, $_)) { |
|
1271 OpenFile(*FILE, $file, 0) or warn("Can't read file `$file'.\n"), last; |
|
1272 while (<FILE>) { |
|
1273 next if ($_ !~ FILESPECSTATEMENT) && ($_ !~ BOOTBINARYSTATEMENT); |
|
1274 $file = GetAbsFname(defined($1) ? $1 : $2); |
|
1275 $files{lc($file)} = $file if !exists($files{lc($file)}); |
|
1276 next if ($file !~ s/\.[0-9a-f]{32}\./\./i); |
|
1277 $file .= (-f("$file.$featvar.vmap") ? ".$featvar.vmap" : ".vmap"); |
|
1278 $files{lc($file)} = $file if !exists($files{lc($file)}); |
|
1279 } |
|
1280 close(FILE); |
|
1281 } |
|
1282 |
|
1283 my ($incfile, $spifile, $plugfile, $patchfile) = (0, 0, 0, 0); |
|
1284 foreach $file (@pluglog) { |
|
1285 OpenFile(*FILE, $file, 0) or warn("Can't read file `$file'.\n"), last; |
|
1286 while (<FILE>) { |
|
1287 $incfile = 1, next if /^Finding include hierarchy from /; |
|
1288 $incfile = 0, next if ($incfile && /^Found \d+ different include files$/); |
|
1289 $spifile = 1, next if /^Finding SPI input files from /; |
|
1290 $spifile = 0, next if ($spifile && /^Found \d+ SPI input files$/); |
|
1291 $plugfile = 1, next if /^Reading (ROM|ROFS1|UDEB|UREL) files from /; |
|
1292 $plugfile = 0, next if ($plugfile && /^Found \d+ entries$/); |
|
1293 $patchfile = 1, next if /^Finding ROM-patched components$/; |
|
1294 $patchfile = 0, next if ($patchfile && /^Found \d+ ROM-patched components$/); |
|
1295 $files{lc($file)} = $file, next |
|
1296 if (($incfile || $spifile || $plugfile) && /`(.+)'$/ && !exists($files{lc($file = GetAbsFname($1))})); |
|
1297 next if (!$patchfile || !/^`(.+)'$/); |
|
1298 $file = GetAbsFname($1) . ".map"; |
|
1299 $files{lc($file)} = $file, next if -f($file); |
|
1300 $file =~ s/(\..*?\.map)$/\.\*$1/; |
|
1301 foreach (glob($file =~ /\s/ ? "\"$file\"" : $file)) { |
|
1302 ($file = lc()) =~ s/\.map$//; |
|
1303 $files{lc()} = $_, last if exists($files{$file}); |
|
1304 } |
|
1305 } |
|
1306 close(FILE); |
|
1307 } |
|
1308 |
|
1309 $dir .= "/" if $dir !~ /\/$/; |
|
1310 foreach $file (keys(%files)) { |
|
1311 delete($files{$file}) if ($file =~ /^$dir/i); |
|
1312 } |
|
1313 } |
|
1314 |
|
1315 @gFindresult = () if (!defined($opt) || $opt !~ /a/); |
|
1316 push(@gFindresult, values(%files)); |
|
1317 } |
|
1318 |
|
1319 |
|
1320 ############################################################################### |
|
1321 # |
|
1322 |
|
1323 sub CheckTool(@) |
|
1324 { |
|
1325 return if SkipICmd(); |
|
1326 my ($maxtlen, $maxvlen, @tools) = (4, 9, ()); |
|
1327 while (@_) { |
|
1328 my ($tool, $vquery, $getver, $version, $md5sum) = (shift(), shift(), shift(), " -", " ?"); |
|
1329 if (length($vquery) > 1) { |
|
1330 RunSystemCmd($vquery, 3, 1); |
|
1331 $version = (join("\n", @gCmdoutbuf) =~ eval($getver =~ /^\// ? "qr$getver" : "qr/$getver/ims") ? |
|
1332 (defined($1) && defined($2) && "`$1 $2'" || defined($1) && "`$1'" || " ?") : " ?"); |
|
1333 } |
|
1334 OpenFile(*FILE, $tool, 1) and $md5sum = "`" . md5_hex(<FILE>) . "'"; |
|
1335 close(FILE); |
|
1336 $maxtlen = Max($maxtlen, length($tool)); |
|
1337 $maxvlen = Max($maxvlen, length($version)); |
|
1338 push(@tools, "`$tool'", $version, $md5sum); |
|
1339 } |
|
1340 $maxtlen += 2; |
|
1341 @_ = (" Tool", " Version", " MD5 Checksum", "-" x $maxtlen, "-" x $maxvlen, "-" x 34, @tools); |
|
1342 DPrint(1, sprintf("%-${maxtlen}s %-${maxvlen}s ", shift(), shift()) . shift() . "\n") while(@_); |
|
1343 } |
|
1344 |
|
1345 |
|
1346 ############################################################################### |
|
1347 # |
|
1348 |
|
1349 sub OpCacheInstall($$$) |
|
1350 { |
|
1351 return if SkipICmd(); |
|
1352 my ($ini, $conf, $tmpdir) = @_; |
|
1353 my %opt = (-e => "", -i => "", -m => "", -o => "", -u => ""); |
|
1354 |
|
1355 foreach $conf ("opcache_config=$conf", ($ini ne "" ? grep(!/^\s*#/, ReadFile($ini, 0)) : ())) { |
|
1356 (local $_, my $error, my %tmpopt) = ($conf, 0, %opt); |
|
1357 if (!($error = !(s/^\s*opcache_config\s*[=\s]//i || s/^\s*opcache_content\s*[=\s]/-i /i))) { |
|
1358 my @opt = ParseCmdWords($_); |
|
1359 while (@opt) { |
|
1360 last if ($error = ((($_ = shift(@opt)) !~ /^-[eimou]$/i) || |
|
1361 !defined($tmpopt{$_} = shift(@opt)))); |
|
1362 $tmpopt{$_} =~ s/EPOCROOT/$gEpocroot/g; |
|
1363 } |
|
1364 } |
|
1365 die("OpCacheInstall: Invalid configuration entry: `$conf'\n"), next if $error; |
|
1366 %opt = %tmpopt; |
|
1367 } |
|
1368 if (-d($opt{-i})) { |
|
1369 $opt{-i} = GetAbsDirname($opt{-i}); |
|
1370 } elsif (-f($opt{-i})) { |
|
1371 DeleteDir($tmpdir); |
|
1372 MakeDir($tmpdir); |
|
1373 RunSystemCmd("$gTool{unzip} x -y \"" . GetAbsFname($opt{-i}) . "\"" . |
|
1374 " -o\"" . ($tmpdir = GetAbsDirname($tmpdir)) . "\"", 0, 1); |
|
1375 $opt{-i} = $tmpdir; |
|
1376 } |
|
1377 RunSystemCmd("$gTool{opcache} -u \"$opt{-u}\" -e \"$opt{-e}\" -m \"" . |
|
1378 GetAbsFname($opt{-m}) . "\" -i \"$opt{-i}\" -o \"" . GetAbsDirname($opt{-o}) . "\""); |
|
1379 } |
|
1380 |
|
1381 |
|
1382 ############################################################################### |
|
1383 # |
|
1384 |
|
1385 sub SisInstall($$$$$$$$) |
|
1386 { |
|
1387 return if SkipICmd(); |
|
1388 |
|
1389 my ($ini, $intini, $conf, $hda, $hdata, $idata, $outdir, $log) = |
|
1390 (GetAbsFname(shift()), GetAbsFname(shift()), shift(), GetAbsFname(shift()), |
|
1391 shift(), shift(), GetAbsDirname(shift()), shift()); |
|
1392 my %gopt = (-d => "C", -k => "5.4", -w => "info", '--ignore-err' => 0); |
|
1393 |
|
1394 my %haldata = (); |
|
1395 map { $haldata{uc($1)} = $2 if /^\s*(\S+)\s+(\S+)\s*$/ } split(/(?<!\\)\\n/, $hdata); |
|
1396 $gOutfilter = '\S'; |
|
1397 RunSystemCmd("$gTool{cpp} -nostdinc -undef \"$hda\"", 1, 1, $log) if ($hda ne ""); |
|
1398 |
|
1399 local @_ = (map(!/^\s*E(\S+)\s*=\s*(\S+)\s*$/ ? () : (uc($1) . " = " . |
|
1400 (exists($haldata{uc($2)}) ? $haldata{uc($2)} : (exists($haldata{uc("E$1_$2")}) ? |
|
1401 $haldata{uc("E$1_$2")} : $2)) . "\n"), @gCmdoutbuf), |
|
1402 map(/^\s*$/ ? () : Trim($_) . "\n", split(/(?<!\\)\\n/, $idata))); |
|
1403 |
|
1404 WriteFile($intini, join("", @_), "", "q"); |
|
1405 RunSystemCmd("$gTool{interpretsis} -i \"$intini\"", 3, 1); |
|
1406 map { $_[$1 - 1] = undef if /Unsupported keyword.+?(\d+)/i } @gCmdoutbuf; |
|
1407 WriteFile($intini, join("", grep(defined(), @_)), "", "q"); |
|
1408 |
|
1409 my ($clean, @dir) = (0, Find($outdir, "*", "", 1, 1, $_)); |
|
1410 @_ = ("sis_config=$conf", ($ini ne "" ? grep(!/^\s*#/, ReadFile($ini, 0)) : ()), "sis_content="); |
|
1411 |
|
1412 for (my $i = 0; $i < @_; $i++) { |
|
1413 local $_ = $_[$i]; |
|
1414 my ($error, $global, $runtool, %opt) = (0, 0, 0, %gopt); |
|
1415 if (!($error = !(s/^\s*sis_(config)\s*[=\s]//i || s/^\s*sis_(content)\s*[=\s]/-s /i))) { |
|
1416 $global = ($1 =~ /config/i); |
|
1417 my @opt = ParseCmdWords($_); |
|
1418 while (@opt) { |
|
1419 $_ = shift(@opt); |
|
1420 shift(@opt) if ((my $next = (@opt ? ($opt[0] !~ /^!?[-+]/ ? $opt[0] : "") : "")) ne ""); |
|
1421 next if /^!?-[cilwx]$/; |
|
1422 if (s/^!//) { delete($opt{$_}) } |
|
1423 else { |
|
1424 $_[$#_] .= "\"$next\"", next if (!$i && /^-s$/); |
|
1425 ($opt{$_} = $next) =~ s/EPOCROOT/$gEpocroot/g; |
|
1426 $runtool = ($next !~ /^\s*$/) if /^-s$/; |
|
1427 } |
|
1428 } |
|
1429 } |
|
1430 die("SisInstall: Invalid configuration entry: `$_[$i]'\n"), next if $error; |
|
1431 %gopt = %opt if $global; |
|
1432 next if !$runtool; |
|
1433 |
|
1434 foreach (-d($opt{-s}) ? Find($opt{-s}, '/\.sisx?$/i', "", 0, 0, $_) : (GetAbsFname($opt{-s}))) { |
|
1435 ($opt{-s}, my $puid) = ($_, "?"); |
|
1436 OpenFile(*SISFILE, $_, 1, "") and sysread(SISFILE, $puid, 3 * 4) and |
|
1437 $puid = sprintf("%08X", unpack("V", substr($puid, 8, 4))); |
|
1438 close(SISFILE); |
|
1439 DPrint(16, "SisInstall: `$_', pUID: $puid" . ($opt{'--ignore-err'} ? ", ignore errors\n" : "\n")); |
|
1440 |
|
1441 my $icmd = $gTool{interpretsis} . (join("", map(($opt{$_} ne "" ? " $_ \"$opt{$_}\"" : " $_"), |
|
1442 sort({lc($a) cmp lc($b)} grep(/^-[^s]/ && !/^--ignore-err$/, keys(%opt)))))) . |
|
1443 " -c \"" . (GetAbsDirname($outdir)) . "\" -i \"" . (GetAbsFname($intini)) . "\""; |
|
1444 $error = RunSystemCmd("$icmd -s \"$opt{-s}\"" . join("", map(" $_", |
|
1445 sort({lc($a) cmp lc($b)} grep(/^\+/, keys(%opt))))), 1, 1, ">>$log"); |
|
1446 my $errmsg = join(" | ", grep(s/^ERR\s*:\s*//, @gCmdoutbuf)); |
|
1447 |
|
1448 $_ = join(", ", map(/^INFO:\s+Installing file:\s+\w:\\sys\\bin\\(.+?.exe)\s*$/io && |
|
1449 ($_ = $1) && (qx($gTool{elf2e32} --dump=h --e32input "$outdir/sys/bin/$_") =~ |
|
1450 /^Uids:\s+.+?\s+([0-9a-f]+)\s+\(/imo) ? "$_: " . uc($1) : (), @gCmdoutbuf)); |
|
1451 DPrint(16, "SisInstall: `" . GetBasename($opt{-s}) . "', exe UIDs: $_\n") |
|
1452 if ($_ && (!($error ||= $errmsg) || $opt{'--ignore-err'})); |
|
1453 |
|
1454 warn("Installation of SIS file `$opt{-s}' failed" . ($errmsg ? ": `$errmsg'.\n" : ".\n")) |
|
1455 if ($gErrwarn = $error); |
|
1456 next if (!$error || $opt{'--ignore-err'}); |
|
1457 $clean = 1; |
|
1458 warn("Removing installation of SIS file `$opt{-s}'.\n"); |
|
1459 RunSystemCmd("$icmd -x $puid", 3, 1, ">>$log"); |
|
1460 } |
|
1461 } |
|
1462 return if !$clean; |
|
1463 my $i = 0; |
|
1464 foreach (Find($outdir, "*", "", 1, 1, $_)) { |
|
1465 if (($i <= $#dir) && ($_ eq $dir[$i])) { $i++ } |
|
1466 else { DeleteDir($_) } |
|
1467 } |
|
1468 } |
|
1469 |
|
1470 |
|
1471 ############################################################################### |
|
1472 # |
|
1473 |
|
1474 sub GetIPar(;$) |
|
1475 { |
|
1476 my $par = shift(@gIcmd); |
|
1477 $par = ((my $empty = !defined($par)) ? "<UNDEFINED>" : PEval($par)); |
|
1478 $gParamcnt = 0 if shift(); |
|
1479 DPrint(32, "iPar: $gParamcnt. `$par'\n") if $gParamcnt && ($gICmd =~ $gFiltercmd); |
|
1480 $gParamcnt++; |
|
1481 return($empty ? undef : $par); |
|
1482 } |
|
1483 |
|
1484 sub PEval($) |
|
1485 { |
|
1486 local $_ = shift(); |
|
1487 while (/\@PEVAL{.*}LAVEP\@/) { |
|
1488 my $start = rindex($_, '@PEVAL{', my $end = index($_, '}LAVEP@') + 7); |
|
1489 my ($expr, $eval, $evalerr) = (substr($_, $start + 7, $end - $start - 14), undef, ""); |
|
1490 eval { |
|
1491 local $_; |
|
1492 local $gEvalerr = (SkipICmd() ? 1 : 2); |
|
1493 $eval = eval($expr); |
|
1494 ($evalerr = $@) =~ s/^(.+?) at .*/$1/s; |
|
1495 }; |
|
1496 # DPrint(64, "PEval: Evaluate `$expr' = `" . (defined($eval) ? $eval : "") . "'\n"); |
|
1497 if (!defined($eval)) { |
|
1498 $eval = ""; |
|
1499 warn("PEval: Evaluation of `$expr' failed: $evalerr.\n") if !SkipICmd(); |
|
1500 } |
|
1501 substr($_, $start, $end - $start) = $eval; |
|
1502 } |
|
1503 return($_); |
|
1504 } |
|
1505 |
|
1506 sub PeekICmd($) |
|
1507 { |
|
1508 return(defined($gIcmd[0]) && $gIcmd[0] =~ /^$_[0]$/i); |
|
1509 } |
|
1510 |
|
1511 sub SkipICmd() |
|
1512 { |
|
1513 return($gPrintcmd || defined($gICmd) && ($gICmd !~ $gFiltercmd)); |
|
1514 } |
|
1515 |
|
1516 sub GetICmd() |
|
1517 { |
|
1518 $gICmd = GetIPar(1); |
|
1519 DPrint(32, "iCmd: " . ++$gCmdcnt . ". `$gICmd'\n") if defined($gICmd) && ($gICmd ne "") && ($gICmd =~ $gFiltercmd); |
|
1520 } |
|
1521 |
|
1522 sub EndICmd() |
|
1523 { |
|
1524 GetICmd(), return(1) if !defined($gIcmd[0]) || PeekICmd("end"); |
|
1525 return(0); |
|
1526 } |
|
1527 |
|
1528 |
|
1529 ############################################################################### |
|
1530 # |
|
1531 |
|
1532 sub SplitStep($) |
|
1533 { |
|
1534 (my $step = shift()) =~ s/(?<!(\\|\s))\|/ \|/g; # ??? |
|
1535 return(map((s/^\s+|(?<!\\)\s+$//g, s/\\\|/\|/g) ? $_ : $_, split(/(?<!\\)\|/, "$step "))); |
|
1536 } |
|
1537 |
|
1538 sub RunStep($) |
|
1539 { |
|
1540 ($gStep, my $dur, @gStepDur) = (shift(), time(), ()); |
|
1541 ChangeDir($gWorkdir); |
|
1542 DPrint(2, "=" x 79 . "\nENTER: `$gStep'\n"); |
|
1543 |
|
1544 push(@gReport, $gLogfile ? ("iMaker log", $gLogfile =~ /^>>?([^>].*)$/ ? $1 : $gLogfile, "f") : (), |
|
1545 SplitStep($gStepIcmd{"REPORT_$gStep"})) if exists($gStepIcmd{"REPORT_$gStep"}); |
|
1546 |
|
1547 foreach my $step ("INIT_$gStep", "CLEAN_$gStep", "BUILD_$gStep") { |
|
1548 next if (!exists($gStepIcmd{$step}) || $gStepIcmd{$step} =~ /^\s*$/); |
|
1549 DPrint(64, "$step = `$gStepIcmd{$step}'\n"); |
|
1550 @gIcmd = SplitStep($gStepIcmd{$step}); |
|
1551 my ($file, $iferror, @iffi) = ("", 0, ()); |
|
1552 |
|
1553 while (GetICmd(), defined($gICmd)) { |
|
1554 next if (local $_ = lc($gICmd)) eq ""; |
|
1555 if (/^if$/) { |
|
1556 push(@iffi, (my $if = GetIPar()), $gFiltercmd); |
|
1557 $gFiltercmd = qr/^X$/ if !$if; |
|
1558 } |
|
1559 elsif (/^else$/) { |
|
1560 $gFiltercmd = ($iffi[$#iffi - 1] ? qr/^X$/ : $iffi[$#iffi]); |
|
1561 } |
|
1562 elsif (/^fi$/) { |
|
1563 $gFiltercmd = pop(@iffi); |
|
1564 pop(@iffi); |
|
1565 } |
|
1566 elsif (/^(error|warning)$/) { |
|
1567 my ($errwarn, $msg) = (GetIPar(), GetIPar() . "\n"); |
|
1568 next if SkipICmd(); |
|
1569 die($msg) if $errwarn && /e/; |
|
1570 warn($msg) if $errwarn && /w/; |
|
1571 } |
|
1572 elsif (/^echo(\d+)?(-q)?$/) { |
|
1573 Echo((defined($1) && ($1 < 128) ? $1 : 1), GetIPar(), defined($2)); |
|
1574 } |
|
1575 elsif (/^filter$/) { |
|
1576 $gOutfilter = GetIPar(); |
|
1577 } |
|
1578 elsif (/^cmd(tee)?(-(k[0123]?|n)+)?$/) { |
|
1579 RunSystemCmd(GetIPar(), (/k(\d)/ ? int($1) : (/k/ ? 1 : 0)), /n/, /tee/ ? GetIPar() : ""); |
|
1580 } |
|
1581 elsif (/^parse(f)?(?:-(\d+))?$/) { |
|
1582 ParseSystemCmd(GetIPar(), GetIPar(), GetIPar(), $1, $2); |
|
1583 } |
|
1584 elsif (/^(cd|copy(dir|iby)?|del(dir)?|find(dir)?(-[afr]+)?|headb|logfile|mkcd|mkdir|move|tailb|test|touch|type[bu]?|unzip|workdir|write[bu]?(-[cq]+)?|zip(dir)?(-[jq]+)?)$/) { |
|
1585 my @files = GlobFiles(GetIPar()); |
|
1586 my $par1 = GetIPar() if /^(?:copy|find|head|move|tail|touch|(un)?zip|write)/; |
|
1587 my $par2 = GetIPar() if /^(?:find|head|tail|zip)/; |
|
1588 next if SkipICmd(); |
|
1589 @gFindresult = () if /find(?:dir)?(-[afr]+)?/ && (!defined($1) || ($1 !~ /a/)); |
|
1590 Touch($par1, @files), next if /touch/; |
|
1591 foreach $file (@files) { |
|
1592 ChangeDir($file) if /^cd/; |
|
1593 DeleteDir($file) if /deldir/; |
|
1594 FindDir($file, $par1, $par2, $1) if /finddir(-[ar]+)?/; |
|
1595 MakeDir($file) if /mkdir/; |
|
1596 MakeChangeDir($file) if /mkcd/; |
|
1597 SetWorkdir($file) if /workdir/; |
|
1598 Zip($file, 1, $1, $par2, GlobFiles($par1)) if /zipdir(-[jq]+)?/; |
|
1599 DeleteFile($file) if /del/; |
|
1600 FindFile($file, $par1, $par2, $1) if /find(-[afr]+)?$/; |
|
1601 HeadFile($file, $par1, $par2) if /headb/; |
|
1602 SetLogfile($file) if /logfile/; |
|
1603 TailFile($file, $par1, $par2) if /tailb/; |
|
1604 TypeFile($file, $1) if /type(b|u)?/; |
|
1605 UnzipFile($file, $par1) if /unzip/; |
|
1606 WriteFile($file, $par1, $1, $2) if /write(b|u)?(-[cq]+)?/; |
|
1607 Zip($file, 0, $1, $par2, GlobFiles($par1)) if /^zip(-[jq]+)?$/; |
|
1608 Copy($file, $par1, $1) if /copy(dir)?$/; |
|
1609 CopyIby($file, $par1) if /copyiby/; |
|
1610 Move($file, $par1) if /move/; |
|
1611 Test($file) if /test/; |
|
1612 } |
|
1613 } |
|
1614 elsif (/^filtercmd$/) { |
|
1615 $gFiltercmd = GetIPar(); |
|
1616 $gFiltercmd = ($gFiltercmd eq "" ? qr/\S/ : qr/$gFiltercmd/i); |
|
1617 } |
|
1618 elsif (/^genexclst$/) { |
|
1619 GenExclfile(GetIPar(), GetIPar(), GetIPar(), GetIPar(), GetIPar()); |
|
1620 } |
|
1621 elsif (/^geniby(-[dr]+)?$/) { |
|
1622 my ($opt, $iby, $dir, @par) = ($1 || "", GetIPar(), GetIPar(), ()); |
|
1623 push(@par, GetIPar(), GetIPar()) while !EndICmd(); |
|
1624 GenObyfile($iby, $dir, $opt =~ /r/, $opt =~ /d/ ? 2 : 0, @par); |
|
1625 } |
|
1626 elsif (/^genorideiby$/) { |
|
1627 GenIbyfile(GetIPar(), GetIPar(), GetIPar()); |
|
1628 } |
|
1629 elsif (/^genmk$/) { |
|
1630 GenMakefile(GetIPar(), GetIPar(), GetIPar(), GetIPar(), GetIPar()); |
|
1631 } |
|
1632 elsif (/^genwgzcfg$/) { |
|
1633 GenWidgetConf(GetIPar(), GetIPar(), GetIPar(), GetIPar()); |
|
1634 } |
|
1635 elsif (/^iferror$/) { |
|
1636 $iferror++; |
|
1637 $gError = 0, next if $gError; |
|
1638 while (defined($gIcmd[0])) { |
|
1639 GetICmd(), last if PeekICmd("endif") && !--$iferror; |
|
1640 $iferror++ if shift(@gIcmd) =~ /^iferror$/i; |
|
1641 } |
|
1642 } |
|
1643 elsif (/^endif$/ && $iferror--) { |
|
1644 } |
|
1645 elsif (/^imghdr$/) { |
|
1646 AddImageHeader(GetIPar(), GetIPar(), GetIPar(), GetIPar(), GetIPar()); |
|
1647 } |
|
1648 elsif (/^pause$/) { |
|
1649 DPrint(0, "Press Enter to continue...\n"); |
|
1650 getc(); |
|
1651 } |
|
1652 elsif (/^sleep$/) { |
|
1653 Sleep(GetIPar()); |
|
1654 } |
|
1655 elsif (/^sosfind(-a)?$/) { |
|
1656 my $opt = $1; |
|
1657 FindSOSFiles(GetIPar(), GetIPar(), GetIPar(), $opt); |
|
1658 } |
|
1659 elsif (/^tool-(\w+)$/) { |
|
1660 $gTool{$1} = GetIPar(); |
|
1661 # DPrint(2, "SetTool: $1: `$gTool{$1}'\n"); |
|
1662 } |
|
1663 elsif (/^toolchk$/) { |
|
1664 my @tools = (); |
|
1665 push(@tools, GetIPar(), GetIPar(), GetIPar()) while !EndICmd(); |
|
1666 CheckTool(@tools); |
|
1667 } |
|
1668 elsif (/^opcache$/) { |
|
1669 OpCacheInstall(GetIPar(), GetIPar(), GetIPar()); |
|
1670 } |
|
1671 elsif (/^sisinst$/) { |
|
1672 SisInstall(GetIPar(), GetIPar(), GetIPar(), GetIPar(), |
|
1673 GetIPar(), GetIPar(), GetIPar(), GetIPar()); |
|
1674 } |
|
1675 elsif (!$gImakerext || !RunIExtCmd($_)) { |
|
1676 die("Unknown iMaker command `$gICmd'.\n"); |
|
1677 } |
|
1678 } |
|
1679 } |
|
1680 DPrint(2, "EXIT: `$gStep', duration: " . Sec2Min($dur = time() - $dur) . "\n"); |
|
1681 push(@gStepDur, $dur); |
|
1682 } |
|
1683 |
|
1684 |
|
1685 ############################################################################### |
|
1686 # |
|
1687 |
|
1688 sub GetConfmkList(;$) |
|
1689 { |
|
1690 if (!%gConfmkList) { |
|
1691 my ($dir, $incl, $excl, $depth) = split(/,/, $ENV{IMAKER_MKCONF}); |
|
1692 $dir = GetAbsDirname($dir, 0, 1, $gEpocdrive); |
|
1693 ($incl, $excl) = (qr/$incl/, qr/$excl/); |
|
1694 local $_; |
|
1695 DPrint(16, "FindFile: GetConfmkList: `$ENV{IMAKER_MKCONF}'"); |
|
1696 find(sub { $gConfmkList{$1} = $File::Find::name |
|
1697 if (/$incl/ && !/$excl/ && (($File::Find::name =~ tr/\///) > (($dir =~ tr/\///) + $depth))); |
|
1698 }, $dir); |
|
1699 DPrint(16, ", found " . keys(%gConfmkList) . " files\n"); |
|
1700 $gConfmkList{""} = "" if !%gConfmkList; |
|
1701 } |
|
1702 return(sort({lc($a) cmp lc($b)} grep($_ ne "", values(%gConfmkList)))) if shift(); |
|
1703 } |
|
1704 |
|
1705 sub GetFeatvarIncdir($) |
|
1706 { |
|
1707 open(FILE, "$gEpocroot/epoc32/tools/variant/" . shift() . ".var") or |
|
1708 return("Invalid SBV feature variant"); |
|
1709 my @featdata = <FILE>; |
|
1710 close(FILE); |
|
1711 my @incdir = ("@featdata" =~ /^\s*EXTENDS\s+(.+?)\s*$/m ? GetFeatvarIncdir($1) : ()); |
|
1712 @incdir = () if ("@incdir" =~ /^Invalid/); |
|
1713 foreach (@featdata) { |
|
1714 next if !/^\s*ROM_INCLUDE\s+(\S+)\s+(.+?)\s*$/; |
|
1715 if ($1 eq "set") { @incdir = ($2) } |
|
1716 elsif ($1 eq "prepend") { unshift(@incdir, $2) } |
|
1717 elsif ($1 eq "append") { push(@incdir, $2) } |
|
1718 } |
|
1719 return(map("$_/" =~ /^$gEpocroot\// ? $_ : $gEpocroot . PathConv($_, 0, 1, $gEpocdrive), |
|
1720 map(PathConv($_, 0, 0, $gEpocdrive), @incdir))); |
|
1721 } |
|
1722 |
|
1723 |
|
1724 ############################################################################### |
|
1725 # |
|
1726 |
|
1727 sub SetVerbose($;$) |
|
1728 { |
|
1729 my $verbose = Trim(shift()); |
|
1730 $verbose = 127 if $verbose =~ /^debug$/i; |
|
1731 $gVerbose = int($1), return if ($verbose =~ /^(\d+)$/) && ($1 < 128); |
|
1732 $gVerbose = 1; |
|
1733 warn("Verbose level `$verbose' is not integer between 0 - 127\n") if !shift(); |
|
1734 } |
|
1735 |
|
1736 sub CloseLog() |
|
1737 { |
|
1738 close(LOG) if $gLogfile; |
|
1739 $gLogfile = ""; |
|
1740 } |
|
1741 |
|
1742 |
|
1743 ############################################################################### |
|
1744 # |
|
1745 |
|
1746 sub RunIMakerCmd($$$$$@) |
|
1747 { |
|
1748 my ($makecmd, $cmdarg, $tgtext, $mklevel, $skipsteps, %prevtgt) = @_; |
|
1749 $ENV{IMAKER_MKLEVEL} = $mklevel; |
|
1750 |
|
1751 ($cmdarg, my $hptgt, my @targets) = HandleCmdArg($cmdarg); |
|
1752 |
|
1753 foreach my $tgt (@targets) { |
|
1754 my $skipstep = ($tgt =~ s/#$//) || $skipsteps; |
|
1755 (my $target = "$tgt$tgtext") =~ s/(\[\d+\])(.+)$/$2$1/; |
|
1756 if ($target eq "menu") { |
|
1757 ($cmdarg, $target) = Menu($cmdarg); |
|
1758 next if ($target eq "menu"); |
|
1759 ($cmdarg) = HandleCmdArg($cmdarg); |
|
1760 } |
|
1761 $prevtgt{$target =~ /^([^-]+)/ ? $1 : $target} = 1; |
|
1762 push(@gReport, Trim((($target !~ /^(.+)\[\d+\]$/) || ($gVerbose & 64) ? $target : $1) . |
|
1763 ($skipstep ? "#" : "") . " $hptgt"), -1, -$mklevel - 1); |
|
1764 my $tgtind = $#gReport; |
|
1765 my @targets = RunMakeCmd("$makecmd $cmdarg" . ($target eq "defaultgoals" ? "" : " \"$target\"") . |
|
1766 join("", map(" \"$_\"", split(/\s+/, $hptgt))), $skipstep); |
|
1767 $gReport[$tgtind - 2] .= " (intermediate)" if @targets; |
|
1768 $gReport[$tgtind - 1] = pop(@gStepDur); |
|
1769 $gReport[$tgtind] = $mklevel + 1 if !$gError; |
|
1770 delete(@gReport[$tgtind - 2 .. $tgtind]) if (@targets && !$gError && !($gVerbose & 64)); |
|
1771 map { |
|
1772 RunIMakerCmd($makecmd, "$cmdarg $_ $hptgt", $target =~ /(-.*)$/ ? $1 : "", $mklevel + 1, $skipstep, %prevtgt) |
|
1773 if !exists($prevtgt{$_}); |
|
1774 } @targets; |
|
1775 } |
|
1776 } |
|
1777 |
|
1778 sub RunMakeCmd($$) |
|
1779 { |
|
1780 ($gStartmk, $gMakecmd, $gError) = (time(), Trim(shift()), 0); |
|
1781 my ($skipstep, $mkstart, $start, $restart, $cwd, %env) = (shift(), 0, 0, 0, Cwd::cwd(), %ENV); |
|
1782 my @stepdur = my @targets = (); |
|
1783 $ENV{IMAKER_MKRESTARTS} = -1; |
|
1784 |
|
1785 do { |
|
1786 InitMkglobals(); |
|
1787 ($gTgterr, my $printvar, my @steps) = (1, "", ()); |
|
1788 $ENV{IMAKER_MKRESTARTS}++; |
|
1789 |
|
1790 if ($gExportvar{""}) { |
|
1791 if (!$ENV{IMAKER_EXPORTMK}) { |
|
1792 (my $tmpfh, $ENV{IMAKER_EXPORTMK}) = File::Temp::tempfile( |
|
1793 File::Spec->tmpdir() . "/imaker_temp_XXXXXXXX", SUFFIX => ".mk", UNLINK => 1); |
|
1794 close($tmpfh); |
|
1795 $ENV{IMAKER_EXPORTMK} =~ tr-\\-\/-; |
|
1796 } |
|
1797 WriteFile($ENV{IMAKER_EXPORTMK}, "# Generated temporary makefile `$ENV{IMAKER_EXPORTMK}'\n" . |
|
1798 "ifndef __IMAKER_EXPORTMK__\n__IMAKER_EXPORTMK__ := 1\n" . |
|
1799 join("", map(/^([^:]+)(?:\:(.+))?$/ && !defined($2) ? "$1=$gExportvar{$_}\n" : |
|
1800 "ifeq (\$(filter $1,\$(TARGETNAME)),)\n$2=$gExportvar{$_}\nendif\n", |
|
1801 sort({($a =~ /([^:]+)$/ && uc($1)) cmp ($b =~ /([^:]+)$/ && uc($1))} |
|
1802 grep(!/^(?:|.*[+:?])$/, keys(%gExportvar))))) . |
|
1803 "else\n" . |
|
1804 join("", map(/^\d{3}(.+[+:?])$/ ? "$1=$gExportvar{$_}\n" : (), sort({$a cmp $b} keys(%gExportvar)))) . |
|
1805 "endif # __IMAKER_EXPORTMK__\n", "", "q", 1); |
|
1806 $gExportvar{""} = 0; |
|
1807 } |
|
1808 |
|
1809 open(MCMD, "$gMakecmd 2>&1 |"); |
|
1810 while (local $_ = <MCMD>) { |
|
1811 chomp(); |
|
1812 DPrint(1, "$_\n"), next if !s/^#iMaker\x1E//; |
|
1813 # DPrint(64, "#iMaker#$_\n"); |
|
1814 |
|
1815 if (/^BEGIN$/) { |
|
1816 $mkstart = time(); |
|
1817 $start = $mkstart if !$start; |
|
1818 next; |
|
1819 } |
|
1820 if (/^STEPS=(.*)$/) { |
|
1821 my $steps = $1; |
|
1822 @steps = split(/\s+/, $steps), next if ($steps !~ s/^target://); |
|
1823 @targets = grep($_ ne "", map(Trim($_), split(/(?<!\\)\|/, $steps))); |
|
1824 next; |
|
1825 } |
|
1826 $gImgtype = $1, next if /^IMAGE_TYPE=(.*)$/; |
|
1827 $gKeepgoing = $1, next if /^KEEPGOING=(.*)$/; |
|
1828 $gPrintcmd = $1, next if /^PRINTCMD=(.*)$/; |
|
1829 SetVerbose($1), next if /^VERBOSE=(.*)$/; |
|
1830 $gStepIcmd{$1} = $2, next if /^((?:BUILD|CLEAN|INIT|REPORT)_\S+?)=(.*)$/; |
|
1831 |
|
1832 if (/^env (\S+?)=(.*)$/) { |
|
1833 DPrint(64, "$1 = `" . ($ENV{$1} = $2) . "'\n") |
|
1834 if (!defined($ENV{$1}) || ($ENV{$1} ne $2)); |
|
1835 next; |
|
1836 } |
|
1837 if (/^var (\S+?)=(.*)$/) { |
|
1838 my ($var, $val) = ($1, $2); |
|
1839 my $upd = ($var !~ s/\?$//); |
|
1840 $gExportvar{$var} = $val, $gExportvar{""}++ |
|
1841 if (!exists($gExportvar{$var}) || ($upd && $gExportvar{$var} ne $val)); |
|
1842 next; |
|
1843 } |
|
1844 if (/^print (\d+) (\S+?)=(.*)$/) { |
|
1845 $printvar = ("=" x 79) . sprintf("\n%-$1s = `$gMakecmd'\n", "Make command") if ($printvar eq ""); |
|
1846 $printvar .= sprintf("%-$1s = `$3'\n", $2); |
|
1847 next; |
|
1848 } |
|
1849 |
|
1850 push(@stepdur, [$restart ? "ReMake" : "Make", Sec2Min(time() - $mkstart)]) if /^END$/; |
|
1851 PrintEnv(2); |
|
1852 DPrint(2, $printvar); |
|
1853 die("Unknown iMaker entry: `$_'\n"), next if !/^END$/; |
|
1854 |
|
1855 pop(@steps) if ($restart = (@steps && $steps[$#steps] eq "RESTART")); |
|
1856 my $durstr = ""; |
|
1857 foreach my $step (@steps) { |
|
1858 next if $skipstep; |
|
1859 RunStep($step); |
|
1860 my ($cmddur, $stepdur) = (0, pop(@gStepDur)); |
|
1861 $durstr = Sec2Min($stepdur); |
|
1862 if (@gStepDur) { |
|
1863 $durstr .= " ("; |
|
1864 foreach my $dur (@gStepDur) { |
|
1865 $cmddur += $dur; |
|
1866 $durstr .= Sec2Min($dur) . " + "; |
|
1867 } |
|
1868 $durstr .= Sec2Min($stepdur - $cmddur) . ")"; |
|
1869 } |
|
1870 push(@stepdur, [$step, $durstr]); |
|
1871 } |
|
1872 |
|
1873 $printvar = ""; |
|
1874 my @env = ($ENV{IMAKER_EXPORTMK}, $ENV{IMAKER_MKRESTARTS}); |
|
1875 %ENV = %env; |
|
1876 ($ENV{IMAKER_EXPORTMK}, $ENV{IMAKER_MKRESTARTS}) = @env; |
|
1877 InitMkglobals(); |
|
1878 ChangeDir($cwd); |
|
1879 |
|
1880 last if $restart; |
|
1881 |
|
1882 my ($maxilen, $maxslen, $maxdlen) = (length(@stepdur . ""), |
|
1883 Max(map(length(@$_[0]), @stepdur)), Max(8, map(length(@$_[1]), @stepdur))); |
|
1884 DPrint(2, "=" x 79 . "\nStep" . " " x ($maxilen + $maxslen - 1) . "Duration\n" . |
|
1885 "=" x ($maxilen + $maxslen + 2) . " " . "=" x $maxdlen . "\n", |
|
1886 map(sprintf("%${maxilen}s. %-${maxslen}s", $_ + 1, $stepdur[$_][0]) . |
|
1887 " $stepdur[$_][1]\n", 0 .. $#stepdur), |
|
1888 "-" x ($maxilen + $maxslen + 2) . " " . "-" x $maxdlen . "\n" . |
|
1889 "Total" . " " x ($maxilen + $maxslen - 2) . Sec2Min(time() - $start) . "\n"); |
|
1890 ($start, @stepdur) = (time(), ()); |
|
1891 } |
|
1892 close(MCMD); |
|
1893 die("\n") if ($? >> 8); |
|
1894 die("Command `$gMakecmd' failed in `" . GetAbsDirname(".") . "'.\n") if ($gTgterr = $gError); |
|
1895 CloseLog(); |
|
1896 } until !$restart; |
|
1897 push(@gStepDur, time() - $gStartmk); |
|
1898 return(@targets); |
|
1899 } |
|
1900 |
|
1901 |
|
1902 ############################################################################### |
|
1903 # |
|
1904 |
|
1905 sub HandleCmdArg($) |
|
1906 { |
|
1907 my $cmdarg = shift(); |
|
1908 my $origarg = $cmdarg = (defined($cmdarg) ? $cmdarg : ""); |
|
1909 |
|
1910 my @cmdout = qx($ENV{PERL} -x $0 --splitarg $cmdarg); |
|
1911 die("Can't parse Make arguments: `$cmdarg'.\n") if $?; |
|
1912 |
|
1913 map { |
|
1914 chomp(); |
|
1915 s/ /\x1E/g; |
|
1916 s/\"/\\\"/g; |
|
1917 s/(\\+)$/$1$1/; |
|
1918 } @cmdout; |
|
1919 $cmdarg = " " . join(" ", @cmdout) . " "; |
|
1920 |
|
1921 if ($cmdarg =~ /^.* VERBOSE\x1E*=(\S*) /) { |
|
1922 (my $verbose = $1) =~ s/\x1E/ /g; |
|
1923 SetVerbose($verbose, 1); |
|
1924 } |
|
1925 |
|
1926 if ($cmdarg =~ /\s+--?conf=(\S*)\s+/) { |
|
1927 (my $prj = $1) =~ /(.*?)(?:;(.*))?$/; |
|
1928 ($prj, my $conf) = ($1, defined($2) ? $2 : ""); |
|
1929 $cmdarg =~ s/\s+--?conf=\S*\s+/ USE_CONE=mk CONE_PRJ=$prj CONE_CONF=$conf cone-pre defaultgoals /; |
|
1930 } |
|
1931 |
|
1932 $cmdarg = " " . HandleExtCmdArg($cmdarg) . " " if $gImakerext; |
|
1933 |
|
1934 $gMakecmd = "$ENV{IMAKER_MAKE} -f $0" . join("", map(" \"$_\"", split(/\s+/, Trim($cmdarg)))); |
|
1935 warn("Can't parse Make targets.\n") |
|
1936 if (!(my $targets = (qx($gMakecmd 2>&1) =~ /\|MAKECMDGOALS=(.*?)\|/ ? " $1 " : "")) && |
|
1937 ($cmdarg !~ /\s-(?:-?v(?:ersion?|ersi?|er?)?|versio\S+)\s/)); |
|
1938 |
|
1939 GetConfmkList() if |
|
1940 grep(!/^(help(-.+)?|print-.+)$/ || /^help-config$/, my @targets = split(/\s+/, Trim($targets))); |
|
1941 |
|
1942 my ($mkfile, $mkfiles, $hptgt) = ("", "", ""); |
|
1943 map { |
|
1944 $cmdarg =~ s/\s+\Q$_\E\s+/ /; |
|
1945 if (exists($gConfmkList{$_})) { |
|
1946 ($mkfile = $gConfmkList{$_}) =~ s/ /\x1E/g; |
|
1947 $mkfiles .= " -f $mkfile"; |
|
1948 $targets =~ s/\s+\Q$_\E\s+/ /; |
|
1949 } |
|
1950 } @targets; |
|
1951 $cmdarg = "$mkfiles$cmdarg"; |
|
1952 |
|
1953 map { $targets =~ s/\s\Q$_\E\s/ /; $hptgt .= " $_" } |
|
1954 grep(/^help-.+$/ && !/^help-config$/, @targets); |
|
1955 map { $targets =~ s/\s\Q$_\E\s/ /; $hptgt .= " $_" } |
|
1956 grep(/^print-.+$/, @targets); |
|
1957 $hptgt = Trim($hptgt); |
|
1958 |
|
1959 if ($targets =~ s/ default(?= )//g) { |
|
1960 ($targets = Trim($targets)) =~ s/ /\x1E/g; |
|
1961 $cmdarg .= "TARGET_DEFAULT=$targets" if ($targets ne ""); |
|
1962 $targets = "default"; |
|
1963 } |
|
1964 @targets = ("defaultgoals@targets") if |
|
1965 !(@targets = map(s/\x1E/ /g ? $_ : $_, split(/\s+/, Trim($targets)))) || ("@targets" eq "#"); |
|
1966 |
|
1967 $mkfiles = ""; |
|
1968 while ($cmdarg =~ s/\s+(-f\s?|--(?:file?|fi?|makefile?|makefi?|make?)[=\s]|IMAKER_CONFMK\x1E*=)(\S+)\s+/ /) { |
|
1969 $mkfile = $2; |
|
1970 ($mkfile = GetAbsFname(scalar($mkfile =~ s/\x1E/ /g, $mkfile))) =~ s/ /\\\x1E/g |
|
1971 if ($1 !~ /^IMAKER_CONFMK/); |
|
1972 $mkfiles .= ($mkfiles eq "" ? "" : chr(0x1E)) . $mkfile; |
|
1973 } |
|
1974 while ($cmdarg =~ s/\s+(\S+?)\x1E*([+:?])=\x1E*(\S+?)\s+/ /) { |
|
1975 ($gExportvar{sprintf("%03s", ++$gExportvar{""}) . "$1$2"} = $3) =~ s/\x1E/ /g; |
|
1976 } |
|
1977 $cmdarg = join(" ", map(scalar(s/\x1E/ /g, "\"$_\""), split(/\s+/, Trim($cmdarg . |
|
1978 ($mkfiles eq "" && ($ENV{IMAKER_MKLEVEL} || grep(/^default$/, @targets)) ? "" : " IMAKER_CONFMK=$mkfiles"))))); |
|
1979 |
|
1980 DPrint(2, "HandleCmdArg: `$origarg' => `$cmdarg', `" . join(" ", @targets) . "', `$hptgt'\n"); |
|
1981 return($cmdarg, $hptgt, @targets); |
|
1982 } |
|
1983 |
|
1984 |
|
1985 ############################################################################### |
|
1986 # |
|
1987 |
|
1988 sub MenuRuncmd($) |
|
1989 { |
|
1990 $ENV{IMAKER_CMDARG} = shift(); |
|
1991 return(map(chomp() ? $_ : $_, qx($ENV{PERL} -x $0 2>&1))); |
|
1992 } |
|
1993 |
|
1994 sub Menu($) |
|
1995 { |
|
1996 (my $cmdarg = " " . shift() . " ") =~ s/\s+"IMAKER_CONFMK="\s+/ /; |
|
1997 my ($prodind, $product, @product) = (0, "", ()); |
|
1998 my ($tgtind, $target, $tgtcols, $tgtrows, @target) = (0, "", 4, 0, ()); |
|
1999 my ($vartype, $varudeb, $varsym); |
|
2000 my $cfgfile = "./imaker_menu.cfg"; |
|
2001 |
|
2002 $cmdarg = ($cmdarg =~ /^\s*$/ ? "" : " " . Trim($cmdarg)); |
|
2003 open(FILE, "<$cfgfile") and |
|
2004 (($prodind, $tgtind, $vartype, $varudeb, $varsym) = map(chomp() ? $_ : $_, <FILE>)) and close(FILE); |
|
2005 ($prodind, $tgtind, $vartype, $varudeb, $varsym) = |
|
2006 ($prodind || 0, $tgtind || 0, $vartype || "rnd", $varudeb || 0, $varsym || 0); |
|
2007 |
|
2008 while (1) { |
|
2009 print("\nPRODUCTS\n--------\n"); |
|
2010 # |
|
2011 if (!@product) { |
|
2012 @product = sort({lc($a) cmp lc($b)} grep($_ ne "", keys(%gConfmkList))); |
|
2013 $prodind = 0 if ($prodind > @product); |
|
2014 } |
|
2015 $product = ($prodind ? " $product[$prodind - 1]" : ""); |
|
2016 my $maxlen = Max(map(length($_), @product)); |
|
2017 map { |
|
2018 printf(" %" . (length(@product)) . "s) %-${maxlen}s %s\n", $_ + 1, $product[$_], $gConfmkList{$product[$_]}); |
|
2019 } (0 .. $#product); |
|
2020 print(" NO PRODUCTS FOUND!\n") if !@product; |
|
2021 |
|
2022 print("\nTARGETS\n-------\n"); |
|
2023 # |
|
2024 if (!@target) { |
|
2025 @target = grep(s/^== (.+) ==$/$1/, MenuRuncmd("$product PRINTCMD=0 VERBOSE=1 help-target-*-wiki")); |
|
2026 $tgtind = 0 if ($tgtind > @target); |
|
2027 $tgtrows = int($#target / $tgtcols + 1); |
|
2028 my $maxind = 0; |
|
2029 map { |
|
2030 if (!($_ % $tgtrows)) { |
|
2031 $maxind = length(Min($_ + $tgtrows, $#target + 1)) + 1; |
|
2032 $maxlen = Max(map(length(), @target[$_ .. Min($_ + $tgtrows - 1, $#target)])); |
|
2033 } |
|
2034 $target[$_] = sprintf("%${maxind}s) %-${maxlen}s", "t" . ($_ + 1), $target[$_]); |
|
2035 } (0 .. $#target); |
|
2036 } |
|
2037 ($target = ($tgtind ? $target[$tgtind - 1] : "")) =~ s/^.+?(\S+)\s*$/$1/; |
|
2038 foreach my $row (1 .. $tgtrows) { |
|
2039 foreach my $col (1 .. $tgtcols) { |
|
2040 my $ind = ($col - 1) * $tgtrows + $row - 1; |
|
2041 print(($ind < @target ? " $target[$ind]" : "") . ($col != $tgtcols ? " " : "\n")); |
|
2042 } |
|
2043 } |
|
2044 print(" NO TARGETS FOUND!\n") if !@target; |
|
2045 |
|
2046 print("\nCONFIGURATION\n-------------\n"); |
|
2047 # |
|
2048 print( |
|
2049 " Product: " . ($prodind ? $product[$prodind - 1] : "NOT SELECTED!") . "\n" . |
|
2050 " Target : " . ($tgtind ? $target : "NOT SELECTED!") . "\n" . |
|
2051 " Type : " . ucfirst($vartype) . "\n" . |
|
2052 " Debug : " . ($varudeb ? ($varudeb =~ /full/i ? "Full debug" : "Enabled") : "Disabled") . "\n" . |
|
2053 " Symbols: " . ($varsym ? "Created\n" : "Not created\n")); |
|
2054 |
|
2055 print("\nOPTIONS\n-------\n"); |
|
2056 # |
|
2057 print( |
|
2058 " t) Toggle type between rnd/prd/subcon\n" . |
|
2059 " u) Toggle debug between urel/udeb/udeb full\n" . |
|
2060 " s) Toggle symbol creation on/off\n" . |
|
2061 " r) Reset configuration\n" . |
|
2062 " h) Print usage information\n" . |
|
2063 " x) Exit\n\n" . |
|
2064 "Hit Enter to run: imaker$product$cmdarg TYPE=$vartype USE_UDEB=$varudeb USE_SYMGEN=$varsym $target\n"); |
|
2065 |
|
2066 print("\nSelection: "); |
|
2067 # |
|
2068 my $input = <STDIN>; |
|
2069 ($input = (defined($input) ? $input : "?")) =~ s/^\s*(.*?)\s*$/\L$1\E/; |
|
2070 |
|
2071 if ($input =~ /^(\d+)$/ && ($1 > 0) && ($1 <= @product) && ($1 != $prodind)) { |
|
2072 $prodind = $1; |
|
2073 ($tgtind, @target) = (0, ()); |
|
2074 } |
|
2075 elsif ($input =~ /^t(\d+)$/ && ($1 > 0) && ($1 <= @target) && ($1 != $tgtind)) { |
|
2076 $tgtind = $1; |
|
2077 } |
|
2078 elsif ($input eq "t") { |
|
2079 $vartype = ($vartype =~ /rnd/i ? "prd" : ($vartype =~ /prd/i ? "subcon" : "rnd")); |
|
2080 } |
|
2081 elsif ($input eq "u") { |
|
2082 $varudeb = (!$varudeb ? 1 : ($varudeb !~ /full/i ? "full" : 0)); |
|
2083 } |
|
2084 elsif ($input eq "s") { |
|
2085 $varsym = ($varsym ? 0 : 1); |
|
2086 } |
|
2087 elsif ($input eq "r") { |
|
2088 ($prodind, @product) = (0, ()); |
|
2089 ($tgtind, @target) = (0, ()); |
|
2090 ($vartype, $varudeb, $varsym) = ("rnd", 0, 0); |
|
2091 } |
|
2092 elsif ($input eq "h") { |
|
2093 print("\nTODO: Help"); |
|
2094 sleep(2); |
|
2095 } |
|
2096 elsif ($input =~ /^(x|)$/) { |
|
2097 open(FILE, ">$cfgfile") and |
|
2098 print(FILE map("$_\n", ($prodind, $tgtind, $vartype, $varudeb, $varsym))) and close(FILE); |
|
2099 return(("", "menu")) if ($input eq "x"); |
|
2100 $cmdarg = "$product$cmdarg TYPE=$vartype USE_UDEB=$varudeb USE_SYMGEN=$varsym"; |
|
2101 $ENV{IMAKER_CMDARG} = Trim("$cmdarg $target"); |
|
2102 return(($cmdarg, $target eq "" ? "defaultgoals" : $target)); |
|
2103 } |
|
2104 } |
|
2105 } |
|
2106 |
|
2107 |
|
2108 ############################################################################### |
|
2109 # |
|
2110 |
|
2111 sub Install($$$) |
|
2112 { |
|
2113 my ($clean, $bldinf, $destdir) = @_; |
|
2114 my $srcdir = GetDirname($bldinf = GetAbsFname($bldinf)); |
|
2115 $destdir = GetAbsDirname($destdir) if $destdir; |
|
2116 |
|
2117 print(($clean ? "\nCleaning" : "\nInstalling") . " `$bldinf'" . ($destdir ? " to `$destdir'\n" : "\n")); |
|
2118 |
|
2119 my $export = 0; |
|
2120 foreach (grep(!/^\s*\/\//, ReadFile($bldinf, 0))) { |
|
2121 $export = 1, next if /^\s*PRJ_EXPORTS\s*$/i; |
|
2122 next if !$export; |
|
2123 Install($clean, "$srcdir$1", $destdir), next if /^\s*#include\s+"(.+)"\s*$/; |
|
2124 die("Unknown line `$_'.\n") if !/^\s*(\S+)\s+(.+?)\s*$/; |
|
2125 my ($src, $dest) = ("$srcdir$1", $2); |
|
2126 $dest = "$gEpocroot/epoc32$dest" if ($dest =~ s/^\+//); |
|
2127 $dest .= GetBasename($src) if ($dest =~ s/\s+\/\/$//); |
|
2128 ($src, $dest) = (GetAbsFname($src), GetAbsFname($dest)); |
|
2129 next if ($destdir && ($dest !~ /^$gEpocroot\/epoc32\/tools\//i)); |
|
2130 $dest = "$destdir/" . GetBasename($dest) if $destdir; |
|
2131 print(($clean ? "Delete" : "Copy `$src' =>") . " `$dest'\n"); |
|
2132 unlink($dest); |
|
2133 die("Deletion failed.\n") if ($clean && -e($dest)); |
|
2134 next if $clean; |
|
2135 File::Path::mkpath(GetDirname($dest)); |
|
2136 File::Copy::copy($src, $dest) or die("Copying failed.\n"); |
|
2137 chmod(0777, $dest); |
|
2138 } |
|
2139 } |
|
2140 |
|
2141 |
|
2142 ############################################################################### |
|
2143 # |
|
2144 |
|
2145 END { |
|
2146 if (!$gArgv) { |
|
2147 (my $keepgoing, $gStartmk) = ($gKeepgoing, time() - $gStartmk); |
|
2148 $gKeepgoing = 1; |
|
2149 SetLogfile($gLogfiles{__prev__}) if %gLogfiles; |
|
2150 PrintEnv(0) if $gError; |
|
2151 die("Command `$gMakecmd' failed in `" . GetAbsDirname(".") . "'.\n") |
|
2152 if ($gTgterr && !$keepgoing); |
|
2153 |
|
2154 map { UnsubstDrive($_) } sort({$a cmp $b} keys(%gSubstdrv)); |
|
2155 |
|
2156 @gIcmd = @gReport; |
|
2157 (my $report, @gReport) = (2, ()); |
|
2158 my ($maxtlen, $maxvlen, %uniq) = (0, 0, ()); |
|
2159 while (@gIcmd) { |
|
2160 my ($tgtvar, $durval, $type) = (GetIPar(1), GetIPar(1), GetIPar(1)); |
|
2161 if ($type =~ /^-?\d+$/) { |
|
2162 push(@gReport, [$tgtvar, $durval, $type]); |
|
2163 ($maxtlen, %uniq) = (Max($maxtlen, length($tgtvar)), ()); |
|
2164 } else { |
|
2165 $report = 1, push(@gReport, [$tgtvar, $durval, $type]) |
|
2166 if ($tgtvar ne "") && !($uniq{"$tgtvar|$durval"}++); |
|
2167 $maxvlen = Max($maxvlen, length($tgtvar)); |
|
2168 } |
|
2169 } |
|
2170 |
|
2171 my ($tgtcnt, $warn) = (0, 0); |
|
2172 DPrint($report, "=" x 79 . "\n" . join("\n", map(@$_[2] =~ /^-?\d+$/ ? |
|
2173 ($tgtcnt++ ? "-" x 79 . "\n" : "") . |
|
2174 "Target: " . sprintf("%-${maxtlen}s", @$_[0]) . |
|
2175 " Duration: " . Sec2Min(@$_[1] < 0 ? $gStartmk : @$_[1]) . |
|
2176 " Status: " . (@$_[2] < 0 ? ($warn = "FAILED") : "OK") |
|
2177 : sprintf("%-${maxvlen}s", @$_[0]) . " = `@$_[1]'" . |
|
2178 ((@$_[2] =~ /^[fd]$/i) && !-e(@$_[1]) ? " - DOESN'T EXIST" : ""), @gReport)) . |
|
2179 (@gReport ? "\n" . "-" x 79 . "\n" : "") . |
|
2180 "Total duration: " . Sec2Min(time() - $gStarttime) . |
|
2181 " Status: " . ($gError && !$keepgoing ? "FAILED" : "OK" . |
|
2182 ($warn ? " (with keep-going)" : "")) . |
|
2183 "\n" . "=" x 79 . "\n"); |
|
2184 |
|
2185 warn("\$_ has been changed in an uncontrolled manner!\n") |
|
2186 if !/^default input and pattern-searching space$/; |
|
2187 CloseLog(); |
|
2188 exit(1) if ($gError && !$keepgoing); |
|
2189 } |
|
2190 } |
|
2191 |
166 |
2192 |
167 __END__ # OF IMAKER.PL |
2193 __END__ # OF IMAKER.PL |