1 #

     2 # Copyright (c) 2009 Nokia Corporation and/or its subsidiary(-ies).

     3 # All rights reserved.

     4 # This component and the accompanying materials are made available

     5 # under the terms of the License "Symbian Foundation License v1.0"

     6 # which accompanies this distribution, and is available

     7 # at the URL "http://www.symbianfoundation.org/legal/sfl-v10.html".

     8 #

     9 # Initial Contributors:

    10 # Nokia Corporation - initial contribution.

    11 #

    12 # Contributors:

    13 #

    14 # Description: iMaker common Perl routines

    15 #

    16 

    17 

    18 

    19 use subs qw(CORE::GLOBAL::die);

    20 

    21 package imaker;

    22 

    23 use strict;

    24 use warnings;

    25 use Archive::Zip qw(:ERROR_CODES);

    26 use Archive::Zip::Tree;

    27 use Cwd;

    28 use Digest::MD5 qw(md5_hex);

    29 use File::Basename;

    30 use File::Copy;

    31 use File::Find;

    32 use File::Path;

    33 use File::Spec;

    34 use POSIX qw(strftime);

    35 use Time::Local;

    36 use XML::Simple;

    37 

    38 sub Max(@);

    39 sub Min(@);

    40 sub Quote($);

    41 sub Unquote($);

    42 sub Byte2Str($@);

    43 sub Str2Byte($);

    44 sub Str2Xml($);

    45 sub Ascii2Uni($);

    46 sub Uni2Ascii($);

    47 sub GetTimestamp();

    48 sub Sec2Min($);

    49 sub Wcard2Restr($);

    50 sub Wcard2Regex($);

    51 sub DPrint($@);

    52 sub Echo($$$);

    53 sub PathConv($;$$);

    54 sub ParseFiles($);

    55 sub GlobFiles($);

    56 sub GetBasename($);

    57 sub GetDirname($);

    58 sub GetAbsDirname($;$$);

    59 sub GetAbsFname($;$$);

    60 sub GetRelFname($;$$$);

    61 sub GetWriteFname($);

    62 sub GetFreeDrive();

    63 sub Search($$$$$\@\$);

    64 sub Find($$$$$\$);

    65 sub ChangeDir($);

    66 sub DeleteDir($;$);

    67 sub FindDir($$$$);

    68 sub MakeDir($);

    69 sub MakeChangeDir($);

    70 sub SetWorkdir($);

    71 sub OpenFile(*$$;$);

    72 sub Test($);

    73 sub CutFile($$$$$);

    74 sub Copy($$;$);

    75 sub DeleteFile($;$);

    76 sub FindFile($$$$);

    77 sub HeadFile($$$);

    78 sub TailFile($$$);

    79 sub TypeFile($;$);

    80 sub WriteFile($$$;$);

    81 sub UnzipFile($$);

    82 sub Zip($$$$@);

    83 sub Move($$);

    84 sub Touch($$);

    85 sub SetLogfile($);

    86 sub WidgetUnzip($$$);

    87 sub RunSystemCmd($$;$);

    88 sub ParseSystemCmd($$$);

    89 sub GenExclfile($$$$$);

    90 sub GenIbyfile($$$@);

    91 sub GenMakefile($$$$$);

    92 sub AddImageHeader($$$$$);

    93 sub Sleep($);

    94 sub FindSOSFiles($$$$$);

    95 sub CheckTool(@);

    96 sub GetIPar();

    97 sub PeekICmd($);

    98 sub GetICmd();

    99 sub EndICmd();

   100 sub RunICmd();

   101 sub RunIExtCmd($);

   102 sub GetFeatvarIncdir($;$);

   103 sub SetVerbose($);

   104 sub ReadICmdFile($);

   105 sub CloseLog();

   106 sub MakeStep($$$$$$);

   107 sub HandleCmdArg($);

   108 sub HandleExtCmdArg($);

   109 sub MenuRuncmd($);

   110 sub Menu($$$);

   111 

   112 use constant READBUFSIZE => 2097152;  # 2 MB

   113 

   114 our $STARTSTR = '>>>[START]=========8<==========8<==========8<==========8<==========8<==========';

   115 our $ENDSTR   = '==========>8==========>8==========>8==========>8==========>8===========[END]<<<';

   116 

   117 our $gBuflog     = 1;

   118 our $gCmdcnt     = 0;

   119 our @gCmdoutbuf  = ();

   120 our $gEpoc32;

   121 our @gFindresult = ();

   122 our $gError      = 0;

   123 our @gIcmd       = ();

   124 our $gImakerext  = 0;

   125 our $gKeepgoing  = 0;

   126 our @gLogbuf     = ();

   127 our $gLogfile    = "";

   128 our $gMakestep   = "";

   129 our $gOutfilter  = "";

   130 our $gParamcnt   = 0;

   131 our $gPrintcmd   = 0;

   132 our @gStepDur    = ();

   133 our %gStepIcmd   = ();

   134 our $gVerbose    = 1;

   135 our $gWarn       = 0;

   136 our $gWinOS      = ($^O =~ /win/i);

   137 our $gWorkdir    = "";

   138 our $gWorkdrive  = (Cwd::cwd() =~ /^([a-z]:)/i ? $1 : "");

   139 our @iVar        = ();  # General purpose variable to be used from $(call peval,...)

   140 

   141 BEGIN {

   142     ($gEpoc32 = "$ENV{EPOCROOT}epoc32") =~ tr/\\/\//;

   143     push(@INC, "$gEpoc32/tools");

   144     eval { require featurevariantparser };

   145 }

   146 

   147 

   148 ###############################################################################

   149 #

   150 

   151 sub Max(@)

   152 {

   153     my $max = (shift() || 0);

   154     map { $max = $_ if $_ > $max } @_;

   155     return($max);

   156 }

   157 

   158 sub Min(@)

   159 {

   160     my $min = (shift() || 0);

   161     map { $min = $_ if $_ < $min } @_;

   162     return($min);

   163 }

   164 

   165 sub Quote($)

   166 {

   167     local $_ = shift();

   168     return("") if !defined();

   169     s/\\( |n|t)/\\\\$1/g;

   170     return($_);

   171 }

   172 

   173 sub Unquote($)

   174 {

   175     local $_ = shift();

   176     return("") if !defined();

   177     s/(?<!\\)(?<=\\n)\s+(\\n)?//g;

   178     s/(?<!\\)\s+(?=\\n)//g;

   179     s/(?<!\\)\\ / /g;

   180     s/(?<!\\)\\n/\n/g;

   181     s/(?<!\\)\\t/\t/g;

   182     s/\\\\( |n|t)/\\$1/g;

   183     s/\x00//g;

   184     return($_);

   185 }

   186 

   187 sub Byte2Str($@)

   188 {

   189     my ($base, @byte) = @_;

   190     return(join("", map(($_ % 16 ? "" : sprintf("%04X:", $base + $_)) . sprintf(" %02X", $byte[$_]) .

   191         (!(($_ + 1) % 16) || ($_ == (@byte - 1)) ? "\n" : ""), (0 .. (@byte - 1)))));

   192 }

   193 

   194 sub Str2Byte($)

   195 {

   196     my ($str, $ind, @byte) = (shift(), 0, ());

   197     $str =~ s/,$/, /;

   198     map {

   199         $ind++;

   200         s/^\s+|\s+$//g;

   201         if (/^\d+$/ && $_ < 256) {

   202             push(@byte, $_);

   203         } elsif (/^0x[0-9A-F]+$/i && hex() < 256) {

   204             push(@byte, hex());

   205         } else {

   206             die("Invalid $ind. byte: `$_'.\n");

   207             return;

   208         }

   209     } split(/,/, $str);

   210     return(@byte);

   211 }

   212 

   213 sub Str2Xml($)

   214 {

   215     my $str = shift();

   216     $str =~ s/(.)/{'"'=>'&quot;', '&'=>'&amp;', "'"=>'&apos;', '<'=>'&lt;', '>'=>'&gt;'}->{$1} || $1/ge;

   217     return($str);

   218 }

   219 

   220 sub Ascii2Uni($)

   221 {

   222     (local $_ = shift()) =~ s/(?<!\r)\n/\r\n/g;  # Use CR+LF newlines

   223     s/(.)/$1\x00/gs;

   224     return("\xFF\xFE$_");

   225 }

   226 

   227 sub Uni2Ascii($)

   228 {

   229     (local $_ = shift()) =~ s/(.)\x00/$1/gs;

   230     s/\r\n/\n/g;

   231     return(substr($_, 2));

   232 }

   233 

   234 sub GetTimestamp()

   235 {

   236     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = localtime();

   237     return(sprintf("%04d%02d%02d%02d%02d%02d%02d",

   238         $year + 1900, $mon + 1, $mday, $hour, $min, $sec, int(($yday + 1) / 7) + 1));

   239 }

   240 

   241 sub Sec2Min($)

   242 {

   243     my $sec = shift();

   244     return(sprintf("%02d:%02d", $sec / 60, $sec % 60));

   245 }

   246 

   247 sub Wcard2Restr($)

   248 {

   249     (my $wcard = shift()) =~ s/(.)/{"*"=>".*", "?"=>"."}->{$1} || "\Q$1\E"/ge;

   250     return($wcard);

   251 }

   252 

   253 sub Wcard2Regex($)

   254 {

   255     my $restr = Wcard2Restr(shift());

   256     return(qr/$restr/i);

   257 }

   258 

   259 

   260 ###############################################################################

   261 #

   262 

   263 sub DPrint($@)

   264 {

   265     my ($verbose, @outlist) = @_;

   266     map { tr/\x00\x1F/#/ } @outlist;

   267     print(@outlist) if !$verbose || ($verbose & $gVerbose);

   268     push(@gLogbuf, @outlist) if ($verbose < 32) || ($verbose & $gVerbose);

   269     return if $gBuflog && !$gLogfile;

   270     print(LOG @gLogbuf) if $gBuflog;

   271     @gLogbuf = ();

   272 }

   273 

   274 sub Echo($$$)

   275 {

   276     return if $gPrintcmd;

   277     my ($verbose, $str) = (shift(), shift());

   278     DPrint($verbose, shift() ? "$str\n" : Unquote($str));

   279 }

   280 

   281 

   282 ###############################################################################

   283 #

   284 

   285 # Overload die

   286 *CORE::GLOBAL::die = sub {

   287     $gError = 1;

   288     return if PeekICmd("iferror");

   289     CORE::die(@_) if !$gKeepgoing;

   290     warn(@_);

   291 };

   292 

   293 # Handler for __DIE__ signal

   294 $SIG{__DIE__} = sub {

   295     select(STDERR);

   296     DPrint(0, "*** Error: " . ($gMakestep ? "($gMakestep): " : "") . $_[0]);

   297     select(STDOUT);

   298     exit(1);

   299 };

   300 

   301 # Handler for __WARN__ signal

   302 $SIG{__WARN__} = sub {

   303     select(STDERR);

   304     my $msg = ($gMakestep ? "($gMakestep): " : "") . $_[0];

   305     if ($gError) { DPrint(0, "*** Error: $msg") }

   306     else { DPrint(127, "Warning: $msg") }

   307     select(STDOUT);

   308     $gError = $gWarn = 0;

   309 };

   310 

   311 

   312 ###############################################################################

   313 # File operations

   314 

   315 sub PathConv($;$$)

   316 {

   317     my $path = shift();

   318     if (shift()) { $path =~ tr-\/-\\- }

   319     else { $path =~ tr-\\-\/- }

   320     if (shift()) { $path =~ s/^(?![a-z]:)/$gWorkdrive/i }

   321     else { $path =~ s/^$gWorkdrive//i }

   322     $path =~ s/^([a-z]:)/\u$1/;

   323     return($path);

   324 }

   325 

   326 sub ParseFiles($)

   327 {

   328     my ($file, @files) = (shift(), ());

   329     push(@files, defined($1) ? $1 : (defined($2) ? $2 : ())) while $file =~ /""|"+(.+?)"+|((\\\s|\S)+)/g;

   330     return(@files);

   331 }

   332 

   333 sub GlobFiles($)

   334 {

   335     return(@gFindresult) if (my $file = shift()) =~ /^__find__$/i;

   336     return(map(/[\*\?]/ ? glob(/\s/ ? "\"$_\"" : $_) : $_, ParseFiles($file)));

   337 }

   338 

   339 sub GetBasename($)

   340 {

   341     return((File::Basename::fileparse(shift()))[0]);

   342 }

   343 

   344 sub GetDirname($)

   345 {

   346     (my $dir = shift()) =~ s/^>>?(?!>)//;

   347     return((File::Basename::fileparse($dir))[1]);

   348 }

   349 

   350 sub GetAbsDirname($;$$)

   351 {

   352     (my $dir = shift()) =~ s/^>>?(?!>)//;

   353     my $absdir = "";

   354     eval { local $SIG{__DIE__}; $absdir = Cwd::abs_path($dir) };

   355     return(PathConv($absdir || File::Spec->rel2abs($dir,

   356         $dir !~ /^$gWorkdrive/i && $dir =~ /^([a-z]:)/i ? "$1/" : ""), shift(), shift()));

   357 }

   358 

   359 sub GetAbsFname($;$$)

   360 {

   361     my $file = shift();

   362     return($file) if $file eq "" || $file =~ /STD(IN|OUT|ERR)$/;

   363     my $append = ($file =~ s/^>>(?!>)// ? ">>" : "");

   364     return($append . PathConv(File::Spec->catpath("", GetAbsDirname(GetDirname($file)), GetBasename($file)), shift(), shift()));

   365 }

   366 

   367 sub GetRelFname($;$$$)

   368 {

   369     my ($file, $base) = (shift(), shift());

   370     my $append = ($file =~ s/^>>(?!>)// ? ">>" : "");

   371     return($append . PathConv(File::Spec->abs2rel($file, GetAbsDirname(defined($base) && ($base ne "") ? $base : ".")), shift(), shift()));

   372 }

   373 

   374 sub GetWriteFname($)

   375 {

   376     (my $file = shift()) =~ s/^>?/>/;

   377     return($file);

   378 }

   379 

   380 sub GetFreeDrive()

   381 {

   382     for my $drive ("F", "A".."E", "G".."Z") {

   383         return("$drive:") if

   384             !system("subst $drive: . >nul") and !system("subst $drive: /d >nul");

   385     }

   386     die("No free drive letter available.\n");

   387 }

   388 

   389 sub Search($$$$$\@\$)

   390 {

   391     my ($dir, $inclre, $exclre, $subdir, $finddir, $files, $total) = @_;

   392     my @dir = ();

   393 

   394     map {

   395         my $isfile = -f();

   396         my $isdir  = !$isfile && -d();

   397         if ($finddir ? $isdir : $isfile) {

   398             ++$$total;

   399             my $fname = File::Basename::basename($_);

   400             push(@$files, $_) if ($fname =~ /$inclre/ && $fname !~ /$exclre/);

   401         }

   402         push(@dir, $_) if $isdir && $subdir;

   403     } sort({lc($a) cmp lc($b)} ($dir =~ /\s/ ? <"$dir/*"> : <$dir/*>));

   404 

   405     map { Search($_, $inclre, $exclre, 1, $finddir, @$files, $$total) } @dir;

   406 }

   407 

   408 sub Find($$$$$\$)

   409 {

   410     my ($dir, $inclpat, $exclpat, $subdir, $finddir, $total) = @_;

   411     ($dir, $$total) = (GetAbsDirname($dir), 0);

   412     my ($inclre, $exclre, @files) = ("", "", ());

   413     if ($inclpat =~ /^\//) {

   414         $inclre = eval("qr$inclpat");

   415         $inclpat = "";

   416     } else {

   417         $inclre = join("|", map(Wcard2Restr($_), split(/\s+/, $inclpat)));

   418         $inclre = qr/^($inclre)$/i;

   419     }

   420     if ($exclpat =~ /^\//) {

   421         $exclre = eval("qr$exclpat");

   422         $exclpat = "";

   423     } else {

   424         $exclre = join("|", map(Wcard2Restr($_), split(/\s+/, $exclpat)));

   425         $exclre = qr/^($exclre)$/i;

   426     }

   427     DPrint(16, "Find" . ($finddir ? "Dir" : "File") . ": Directory `$dir'" . ($subdir ? " and subdirectories" : "") .

   428         ", pattern `" . ($inclpat ne "" ? "$inclpat' $inclre" : "$inclre'") .

   429         ($exclre eq qr/^()$/i ? "" : " excluding `" . ($exclpat ne "" ? "$exclpat' $exclre" : "$exclre'")));

   430     Search($dir, $inclre, $exclre, $subdir, $finddir, @files, $$total);

   431     DPrint(16, ", found " . @files . "/$$total " . ($finddir ? "directories\n" : "files\n"));

   432     return(@files);

   433 }

   434 

   435 sub ChangeDir($)

   436 {

   437     if ((my $dir = GetAbsDirname(shift())) ne GetAbsDirname(".")) {

   438         DPrint(16, "ChangeDir: `$dir'\n");

   439         chdir($dir) or die("Can't change to directory `$dir'.\n");

   440     }

   441 }

   442 

   443 sub DeleteDir($;$)

   444 {

   445     return if !-d(my $dir = GetAbsDirname(shift()));

   446     DPrint(16, "DeleteDir: `$dir'\n");

   447     for my $sec (0, 2, 5) {

   448         warn("Can't delete directory `$dir', retrying in $sec seconds...\n"), sleep($sec) if $sec;

   449         eval { local $SIG{__DIE__}; local $SIG{__WARN__} = sub{}; File::Path::rmtree($dir) };

   450         return if !-d($dir);

   451     }

   452     $dir = "Can't delete directory `$dir'.\n";

   453     shift() ? warn($dir) : die($dir);

   454 }

   455 

   456 sub FindDir($$$$)

   457 {

   458     my ($dir, $inclpat, $exclpat, $opt) = @_;

   459     @gFindresult = () if (($opt = (defined($opt) ? $opt : "")) !~ /a/);

   460     push(@gFindresult, Find($dir, $inclpat, $exclpat, $opt =~ /r/, 1, local $_));

   461 }

   462 

   463 sub MakeDir($)

   464 {

   465     my $dir = GetAbsDirname(shift());

   466     return if -d($dir);

   467     eval { local $SIG{__DIE__}; File::Path::mkpath($dir) };

   468     if (-d($dir)) {

   469         DPrint(16, "MakeDir: `" . GetAbsDirname($dir) ."'\n");

   470     } else {

   471         DPrint(16, "MakeDir: `$dir'\n");

   472         die("Can't create directory `$dir'.\n");

   473     }

   474 }

   475 

   476 sub MakeChangeDir($)

   477 {

   478     MakeDir(my $dir = shift());

   479     ChangeDir($dir);

   480 }

   481 

   482 sub SetWorkdir($)

   483 {

   484     MakeChangeDir(shift());

   485     $gWorkdrive = (Cwd::cwd() =~ /^([a-z]:)/i ? $1 : "");

   486     $gWorkdir   = GetAbsDirname(".");

   487 }

   488 

   489 sub OpenFile(*$$;$)

   490 {

   491     my ($fhandle, $file, $binmode, $print) = @_;

   492     MakeDir(GetDirname($file)) if $file =~ /^>/;

   493     DPrint(16, defined($print) ? $print : ($file =~ /^>/ ? "Write" : "Read") . "File: `$file'\n");

   494     return(open($fhandle, $file)) if !$binmode;

   495     return(open($fhandle, $file) and binmode($fhandle));

   496 }

   497 

   498 sub Test($)

   499 {

   500     if (-d(my $file = shift())) {

   501         DPrint(16, "TestDir: `" . GetAbsDirname($file) . "'\n");

   502     } elsif (-f($file)) {

   503         DPrint(16, "TestFile: `" . GetAbsFname($file) . "'\n");

   504     } else {

   505         DPrint(16, "Test: `$file'\n");

   506         die("File or directory `$file' doesn't exist.\n");

   507     }

   508 }

   509 

   510 sub CutFile($$$$$)

   511 {

   512     my ($msg, $src, $dest, $head, $len) = @_;

   513     my ($buf, $srctmp) = (undef, "$src.CUT");

   514 

   515     OpenFile(*INFILE, $src, 1, $msg) or

   516         die("Can't read file `$src'.\n"), return;

   517 

   518     my $out = GetWriteFname($head ? $dest : $srctmp);

   519     OpenFile(*OUTFILE, $out, 1) or die("Can't write to `$out'.\n"), return;

   520     while ($len > 0) {

   521         read(INFILE, $buf, $len < READBUFSIZE ? $len : READBUFSIZE);

   522         print(OUTFILE $buf);

   523         $len -= READBUFSIZE;

   524     }

   525     close(OUTFILE);

   526 

   527     $out = GetWriteFname($head ? $srctmp : $dest);

   528     OpenFile(*OUTFILE, $out, 1) or die("Can't write to `$out'.\n"), return;

   529     print(OUTFILE $buf) while read(INFILE, $buf, READBUFSIZE);

   530     close(OUTFILE);

   531     close(INFILE);

   532     Move($srctmp, $src);

   533 }

   534 

   535 sub Copy($$;$)

   536 {

   537     my ($src, $dest, $dir) = @_;

   538     my $append = ($dest =~ /^>>[^>]/);

   539     $dir  = defined($dir) && $dir || !$append && -d($src);

   540     $src  = ($dir ? GetAbsDirname($src)  : GetAbsFname($src));

   541     $dest = ($dir ? GetAbsDirname($dest) : GetAbsFname($dest));

   542     if ($append) {

   543         my $buf;

   544         OpenFile(*INFILE, $src, 1, "AppendFile: `$src' => `$dest'\n") or die("Can't read file `$src'.\n"), return;

   545         OpenFile(*OUTFILE, $dest, 1, "") or die("Can't write to `$dest'.\n"), return;

   546         print(OUTFILE $buf) while read(INFILE, $buf, READBUFSIZE);

   547         return if close(INFILE) && close(OUTFILE);

   548     }

   549     elsif (!$dir) {

   550         DPrint(16, "CopyFile: `$src' => `$dest'\n");

   551         warn("CopyFile: Destination file `$dest' already exists\n") if -f($dest);

   552         File::Copy::copy($src, $dest) and return;

   553     } else {

   554         DPrint(16, "CopyDir: `$src' => `$dest'\n");

   555 #        warn("CopyDir: Destination directory `$dest' already exists\n") if -d($dest);

   556         !RunSystemCmd('xcopy "' . PathConv($src, 1) . '" "' . PathConv("$dest/" . GetBasename($src), 1) . '" /e /i /y /z', "") and return;

   557     }

   558     die("Can't copy `$src' to `$dest'.\n");

   559 }

   560 

   561 sub DeleteFile($;$)

   562 {

   563     return if !-f(my $file = GetAbsFname(shift()));

   564     DPrint(16, "DeleteFile: `$file'\n");

   565     for my $sec (0, 1, 2) {

   566         warn("Can't delete file `$file', retrying in $sec second(s)...\n"), sleep($sec) if $sec;

   567         unlink($file);

   568         return if !-f($file);

   569     }

   570     $file = "Can't delete file `$file'.\n";

   571     shift() ? warn($file) : die($file);

   572 }

   573 

   574 sub FindFile($$$$)

   575 {

   576     my ($dir, $inclpat, $exclpat, $opt) = @_;

   577     @gFindresult = () if (($opt = (defined($opt) ? $opt : "")) !~ /a/);

   578     push(@gFindresult, Find($dir, $inclpat, $exclpat, $opt =~ /r/, 0, local $_));

   579 }

   580 

   581 sub HeadFile($$$)

   582 {

   583     my ($src, $dest, $len) = (GetAbsFname(shift()), GetAbsFname(shift()), shift());

   584     $len = hex($len) if $len =~ /^0x/;

   585     CutFile("HeadFile: Cut first $len bytes from `$src' => `$dest'\n", $src, $dest, 1, $len);

   586 }

   587 

   588 sub TailFile($$$)

   589 {

   590     my ($src, $dest, $len) = (GetAbsFname(shift()), GetAbsFname(shift()), shift());

   591     $len = hex($len) if $len =~ /^0x/;

   592     CutFile("TailFile: Cut last $len bytes from `$src' => `$dest'\n", $src, $dest, 0, (-s($src) ? -s($src) : 0) - $len);

   593 }

   594 

   595 sub TypeFile($;$)

   596 {

   597     my ($file, $str, $mode) = (GetAbsFname(shift()), "", shift() || "");

   598     OpenFile(*FILE, $file, $mode, "TypeFile: `$file'" .

   599         ($gOutfilter && ($mode ne "b") ? ", filter: `/$gOutfilter/i'" : "") . "\n") or

   600             die("Can't read file `$file'.\n"), return;

   601     DPrint(8, "$STARTSTR\n");

   602     read(FILE, $str, -s($file));

   603     if ($mode eq "b") {

   604         DPrint(1, Byte2Str(0, map(ord(), split(//, $str))));

   605     } else {

   606         $str = Uni2Ascii($str) if $mode eq "u";

   607         DPrint(1, map("$_\n", grep(!$gOutfilter || /$gOutfilter/i, split(/\n/, $str))));

   608         $gOutfilter = "";

   609     }

   610     DPrint(8, "$ENDSTR\n");

   611     close(FILE);

   612 }

   613 

   614 sub WriteFile($$$;$)

   615 {

   616     my ($file, $str, $mode) = (GetAbsFname(shift()), shift(), shift() || "");

   617     OpenFile(*FILE, GetWriteFname($file), $mode) or

   618         die("Can't write to `$file'.\n"), return;

   619     if ($mode eq "b") {

   620         my @byte = Str2Byte($str);

   621         DPrint(64, Byte2Str($file =~ s/^>>(?!>)// ? -s($file) : 0, @byte));

   622         print(FILE map(chr(), @byte));

   623     } else {

   624         $str = Unquote($str) if !shift();

   625         $str = Ascii2Uni($str) if $mode eq "u";

   626         print(FILE $str);

   627     }

   628     close(FILE);

   629 }

   630 

   631 sub UnzipFile($$)

   632 {

   633     my ($zipfile, $dir) = (GetAbsFname(shift()), GetAbsDirname(shift()));

   634     DPrint(16, "UnzipFile: `$zipfile'");

   635     Archive::Zip::setErrorHandler(sub{});

   636     my ($error, $zip) = (0, Archive::Zip->new());

   637     if ($zip->read($zipfile) != AZ_OK) {

   638         DPrint(16, " to directory `$dir'\n");

   639         die("Can't read zip archive `$zipfile'.\n");

   640         return;

   641     }

   642     my @files = map($_->fileName(), grep(!$_->isDirectory(), $zip->members()));

   643     DPrint(16, ", " . @files . " files to directory `$dir'\n");

   644     foreach my $file (@files) {

   645         DPrint(16, "ExtractFile: `$dir/$file'");

   646         eval { local $SIG{__DIE__}; $error = ($zip->extractMember($file, "$dir/$file") != AZ_OK) };

   647         DPrint(16, $error ? " Failed\n" : "\n");

   648         die("Can't extract file `$file' to directory `$dir'.\n") if $error;

   649         $error = 0;

   650     }

   651 }

   652 

   653 sub Zip($$$$@)

   654 {

   655     my ($zipfile, $dir, $opt, $prefix) = (GetAbsFname(shift()), shift(), shift(), shift());

   656 

   657     $opt = (defined($opt) ? ", options: `$opt'" : "");

   658     $prefix = GetAbsDirname($prefix) if $prefix ne "";

   659     my %files = ();

   660     map {

   661         my $key = lc();

   662         $files{$key} = $_ if !exists($files{$key});

   663     } ($dir ? map(GetAbsDirname($_), grep(-d(), @_)) : map(GetAbsFname($_), grep(-f(), @_)));

   664 

   665     DPrint(16, ($dir ? "ZipDir: `$zipfile'$opt, " . keys(%files) . " directories" :

   666         "ZipFile: `$zipfile'$opt, " . keys(%files) . " files") . ($prefix ? ", prefix: $prefix\n" : "\n"));

   667 

   668     Archive::Zip::setErrorHandler(sub{});

   669     my ($error, $zip) = (0, Archive::Zip->new());

   670     $zip->zipfileComment("iMaker-created zip archive `$zipfile'$opt.");

   671 

   672     foreach my $file (sort({lc($a) cmp lc($b)} values(%files))) {

   673         my $newfile = $file;

   674         if ($opt !~ /j/) {

   675             $newfile =~ s/^.*?\/+/$prefix\// if $prefix ne "";

   676         } else {

   677             $newfile = ($dir ? "" : GetBasename($file)) if ($prefix eq "") || ($newfile !~ s/^$prefix//);

   678         }

   679         DPrint(16, "Add" . ($dir ? "Dir" : "File") . ": `$file'" . ($file ne $newfile ? " => `$newfile'" : "")) if $opt !~ /q/;

   680         eval {

   681             local $SIG{__DIE__}; local $SIG{__WARN__} = sub{ $gWarn = 1 };

   682             $error = ($dir ? $zip->addTree($file, $newfile) != AZ_OK :

   683                 !$zip->addFile($file, $newfile)) || $gWarn;

   684         };

   685         DPrint(16, $error ? " Failed\n" : "\n") if $opt !~ /q/;

   686         warn("Can't add " . ($dir ? "directory tree" : "file") . "`$file' to zip archive `$zipfile'.\n") if $error;

   687         $error = 0;

   688     }

   689     ($zip->writeToFileNamed($zipfile) == AZ_OK) or

   690         die("Can't create zip archive `$zipfile'.\n");

   691 }

   692 

   693 sub Move($$)

   694 {

   695     my ($src, $dest) = @_;

   696     my $dir = -d($src);

   697     $src = ($dir ? GetAbsDirname($src) : GetAbsFname($src));

   698     MakeDir(GetDirname($dest));

   699     $dest = ($dir ? GetAbsDirname($dest) : GetAbsFname($dest));

   700     DPrint(16, "Move" . ($dir ? "Dir" : "File") . ": `$src' => `$dest'\n");

   701     File::Copy::move($src, $dest) or

   702         die("Can't move `$src' to `$dest'.\n");

   703 }

   704 

   705 sub Touch($$)

   706 {

   707     my ($file, $time) = (shift(), shift() =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/ ?

   708         Time::Local::timelocal($6, $5, $4, $3, $2 - 1, $1 - 1900) : time);

   709     my $dir = -d($file);

   710     $file = ($dir ? GetAbsDirname($file) : GetAbsFname($file));

   711     DPrint(16, "Touch" . ($dir ? "Dir" : "File") . ": `$file': " .

   712         POSIX::strftime("%Y-%m-%d,%H:%M:%S", localtime($time)) . "\n");

   713     utime($time, $time, $file) or

   714         die("Can't touch " . ($dir ? "directory" : "file") . " `$file'.\n");

   715 }

   716 

   717 sub SetLogfile($)

   718 {

   719     $gBuflog = 0, return if !(my $file = GetAbsFname(shift()));

   720     CloseLog();

   721     OpenFile(*LOG, GetWriteFname($file), 0) or

   722         warn("Can't log to file `$file'.\n"), return;

   723     $gLogfile = $file;

   724 }

   725 

   726 

   727 ###############################################################################

   728 #

   729 

   730 sub WidgetUnzip($$$)

   731 {

   732     my ($wgzfile, $outdir, $plist) = (GetAbsFname(shift()), GetAbsDirname(shift()), shift());

   733 

   734     my $tmpdir = "$outdir/wgz_unzip_temp";

   735     DeleteDir($tmpdir);

   736     UnzipFile($wgzfile, $tmpdir);

   737 

   738     for my $dir (Find($tmpdir, "*", "", 0, 1, local $_)) {

   739         my $xml = undef;

   740         eval { local $SIG{__DIE__}; local $SIG{__WARN__} = sub{}; $xml = XMLin("$dir/$plist") };

   741         die("Can't find/parse XML file `$dir/$plist'.\n"), next if !defined($xml);

   742         my $id = "";

   743         for my $ind (0 .. @{$xml->{dict}{key}} - 1) {

   744             $id = $xml->{dict}{string}[$ind], last if $xml->{dict}{key}[$ind] =~ /^\s*Identifier\s*$/i;

   745         }

   746         die("Can't find Identifier from XML file `$dir/$plist'.\n"), next if $id eq "";

   747         Move($dir, "$outdir/$id/" . GetBasename($dir));

   748     }

   749     DeleteDir($tmpdir);

   750 }

   751 

   752 

   753 ###############################################################################

   754 #

   755 

   756 sub RunSystemCmd($$;$)

   757 {

   758     my ($cmd, $file, $ignorerr) = @_;

   759     DPrint(1, "$cmd\n"), return if $gPrintcmd;

   760     my $null = ($file =~ /^null$/i);

   761     $file = ($null ? "" : GetAbsFname($file));

   762     @gCmdoutbuf = ();

   763     DPrint(4, "RunSystemCmd(" . GetAbsDirname(".") . "): `$cmd'" .

   764         ($file ? ", redirect to: `$file'" : ($null ? ", redirect to null" : "")) .

   765         ($gOutfilter ? ", filter: `/$gOutfilter/i'" : "") . "\n");

   766     OpenFile(*FILE, GetWriteFname($file), 0) or

   767         (die("Can't write to `$file'.\n"), $file = "") if $file;

   768     my $dur = time();

   769     open(CMD, "$cmd 2>&1 |");

   770     DPrint(8, "$STARTSTR\n");

   771     while (my $line = <CMD>) {

   772         chomp($line);

   773         push(@gCmdoutbuf, $line);

   774         DPrint(8, "$line\n") if !$null && (!$gOutfilter || ($line =~ /$gOutfilter/i));

   775         print(FILE "$line\n") if $file;

   776     }

   777     close(CMD);

   778     close(FILE) if $file;

   779     push(@gStepDur, $dur = time() - $dur);

   780     $gOutfilter = "";

   781     my $error = ($? >> 8) && !$ignorerr && !$null;

   782     print(map("$_\n", @gCmdoutbuf)) if $error && $gVerbose && !($gVerbose & 8);

   783     $dur = Sec2Min($dur);

   784     DPrint(8, substr($ENDSTR, 0, -16) . $dur . substr($ENDSTR, length($dur) - 16) . "\n");

   785     die("Command `$cmd' failed (" . ($? >> 8). ").\n") if $error;

   786 }

   787 

   788 

   789 ###############################################################################

   790 #

   791 

   792 sub ParseSystemCmd($$$)

   793 {

   794     return if $gPrintcmd;

   795     my ($title, $regex, $file) = @_;

   796     $regex = ($regex =~ /^\// ? eval("qr$regex") : Wcard2Regex($regex));

   797     return if !(my @parse = grep(/$regex/, @gCmdoutbuf));

   798     if (!$file) {

   799         Echo(1, $title, 0);

   800         DPrint(1, map(sprintf("%" . length(@parse) . "s", $_) . ") $parse[$_ - 1]\n", 1 .. @parse));

   801         return;

   802     }

   803     OpenFile(*FILE, GetWriteFname($file = $title), 0) or

   804         die("Can't write to `$file'.\n"), return;

   805     print(FILE join("\n", @parse));

   806     close(FILE);

   807 }

   808 

   809 

   810 ###############################################################################

   811 #

   812 

   813 sub GenExclfile($$$$$)

   814 {

   815     return if $gPrintcmd;

   816 

   817     my ($exclfile, $base, $prefix, $addfiles) = (shift(), shift(), shift(), shift());

   818     my ($file, $rmfiles, %files) = ("", "", ());

   819 

   820     WriteFile($exclfile, "", "");

   821     $base = GetAbsDirname($base);

   822 

   823     foreach $file (ParseFiles(shift())) {

   824         $file =~ tr/\\/\//;

   825         $file =~ s/^\///;

   826         $file =~ s/\/$/\/\*/;

   827         $rmfiles .= ($rmfiles eq "" ? "" : "|") . Wcard2Restr($file);

   828     }

   829     $rmfiles = qr/^(?:$rmfiles)$/i;

   830 

   831     foreach $file (ParseFiles($addfiles)) {

   832         $file =~ tr/\\/\//;

   833         $file =~ /^\/?(?:(.*)\/)?(.+?)$/;

   834         (my $dir, $file) = ($base . (defined($1) ? "/$1" : ""), $2);

   835         map {

   836             $files{$_} = 1 if ($_ = GetRelFname($_, $base)) !~ $rmfiles;

   837         } ($file =~ /[\*\?]/ ? Find($dir, $file, "", 1, 0, local $_) : "$dir/$file");

   838     }

   839 

   840     map {

   841         $files{"$_/"} = 1 while (s/^(.*)\/.*?$/$1/) && !exists($files{"$_/"});

   842     } keys(%files);

   843     $files{""} = 1;

   844 

   845     WriteFile($exclfile, join("", map(($_ = "$prefix$_\n") =~ tr/\//\\/ ? $_ : $_, sort({lc($a) cmp lc($b)} keys(%files)))), "u", 1);

   846 }

   847 

   848 sub GenIbyfile($$$@)

   849 {

   850     return if $gPrintcmd;

   851 

   852     my ($ibyfile, $srcdir, $subdir) = (GetAbsFname(shift()), shift(), shift());

   853     my ($header, $footer, $body, %files) = ("", "", "", ());

   854 

   855     foreach my $dir (split(/\s+/, $srcdir)) {

   856         $dir = GetAbsDirname($dir);

   857         my ($found, $total, $lines) = (0, 0, "");

   858         my @param = @_;

   859         while (@param) {

   860             my ($filepat, $format, @lines) = (shift(@param), shift(@param), ());

   861             $header = $format, next if $filepat =~ /^__header__$/i;

   862             $footer = $format, next if $filepat =~ /^__footer__$/i;

   863             foreach my $src (Find($dir, $filepat, "", $subdir, 0, $total)) {

   864                 next if $files{$src};

   865                 $files{$src} = 1;

   866                 (my $line = $format) =~ s/%1/$src/g;

   867                 $line =~ s/%2/GetRelFname($src, $dir, 1)/ge;

   868                 $line =~ s/%3/GetRelFname($src, GetDirname($ibyfile))/ge;

   869                 push(@lines, $line);

   870             }

   871             $found += @lines;

   872             $lines .= "//\n// Format: `$format', " . @lines . " files: `$filepat'\n" .

   873                 (@lines ? "//\n" . join("\n", @lines) . "\n" : "");

   874         }

   875         $body .= "\n// Collected files $found/$total from directory `$dir'" .

   876             ($subdir ? " and subdirectories" : "") . "\n$lines";

   877     }

   878 

   879     my $append = ($ibyfile =~ s/^>>(?!>)// && -f($ibyfile) && ">>" || "");

   880     (my $fname = "__" . uc(GetBasename($ibyfile)) . "__") =~ s/\W/_/g;

   881     my @previby = ();

   882 

   883     if ($append) {

   884         OpenFile(*FILE, $ibyfile, 0) or die("Can't read file `$ibyfile'.\n"), return;

   885         @previby = <FILE>;

   886         close(FILE);

   887         $previby[0] =~ s/(, collected )(\d+)( files)$/$1.($2 + keys(%files)).$3/e;

   888         $previby[@previby - 1] = "";

   889     }

   890 

   891     OpenFile(*FILE, GetWriteFname($ibyfile), 0) or

   892         die("Can't write to `$ibyfile'.\n"), return;

   893     print(FILE @previby, ($append ? "// Appended" : "// Generated") . " `$append$ibyfile', " .

   894         "collected " . keys(%files) . " files\n" .

   895         ($append ? "" : "\n#ifndef $fname\n#define $fname\n") .

   896         ($header ? Unquote("\\n$header\\n") : "") . $body . ($footer ? Unquote("\\n$footer\\n") : "") .

   897         "\n#endif // $fname\n");

   898     close(FILE);

   899 }

   900 

   901 

   902 ###############################################################################

   903 #

   904 

   905 sub GenMakefile($$$$$)

   906 {

   907     return if $gPrintcmd;

   908     my ($hdrfile, $mkfile, $filter, $prepros, $assignop) =

   909         (GetAbsFname(shift()), GetAbsFname(shift()), shift(), shift(), shift());

   910     ChangeDir(GetDirname($hdrfile));

   911     RunSystemCmd("$prepros " . GetBasename($hdrfile), "");

   912     my $maxdef = Max(map(/^\s*\#define\s+($filter)/ && length($1), @gCmdoutbuf));

   913     WriteFile($mkfile, join('\n',

   914         map(/^\s*\#define\s+($filter)\s*(.*?)\s*$/ ? sprintf("%-${maxdef}s $assignop %s", $1, $2 eq "" ? 1 : $2) : (), sort(@gCmdoutbuf))) . '\n', "");

   915 }

   916 

   917 

   918 ###############################################################################

   919 #

   920 

   921 sub AddImageHeader($$$$$)

   922 {

   923     return if $gPrintcmd;

   924     my ($file, $hdrfile, $hdrstr, $hdrsize, $align) =

   925         (GetAbsFname(shift()), GetAbsFname(shift()), shift(), shift(), shift());

   926 

   927     $hdrstr =~ s/\/\*.*?\*\///g;

   928     $hdrstr =~ s/,\s*$//;

   929     WriteFile($hdrfile, $hdrstr, "b");

   930     die("Invalid image header size: " . sprintf("0x%X", -s($hdrfile)) . " (!=$hdrsize).\n"), return

   931         if -s($hdrfile) ne hex($hdrsize);

   932 

   933     $align = Max(hex($align), hex($hdrsize)) - hex($hdrsize);

   934     WriteFile(">>$hdrfile", ("0," x ($align - 1)) . "0", "b") if $align;

   935     Copy($file, ">>$hdrfile") if $file ne "";

   936 }

   937 

   938 

   939 ###############################################################################

   940 #

   941 

   942 sub Sleep($)

   943 {

   944     sleep(shift()) if !$gPrintcmd;

   945 }

   946 

   947 

   948 ###############################################################################

   949 #

   950 

   951 sub FindSOSFiles($$$$$)

   952 {

   953     my ($dirs, $tmpoby, $imgoby, $pluglog, $opt) = @_;

   954     my ($file, %files) = ("", ());

   955     local $_;

   956 

   957     foreach my $dir (GlobFiles($dirs)) {

   958         $dir = GetAbsDirname($dir);

   959 

   960         foreach $file (Find($dir, $tmpoby, "", 1, 0, $_)) {

   961             OpenFile(*FILE, $file, 0) or warn("Can't read file `$file'.\n"), last;

   962             (my $dir = GetDirname($file) . "/") =~ s/\/+$/\//;

   963             while (<FILE>) {

   964                 next if !/^#\s+\d+\s+"(.+?)"/;

   965                 $_ = $1;

   966                 $file = GetAbsFname(/^(?:[a-z]:)?[\/\\]/i ? $_ : "$dir$_");

   967                 $files{lc($file)} = $file if !exists($files{lc($file)});

   968             }

   969             close(FILE);

   970         }

   971 

   972         foreach $file (Find($dir, $imgoby, "", 1, 0, $_)) {

   973             OpenFile(*FILE, $file, 0) or warn("Can't read file `$file'.\n"), last;

   974             while (<FILE>) {

   975                 next if !/^\s*(?:bootbinary|data|device|dll|extension|file|primary|secondary|variant)\S*?\s*[=\s]\s*(?:"(.+?)"|(\S+))/i;

   976                 $file = GetAbsFname(defined($1) ? $1 : $2);

   977                 $files{lc($file)} = $file if !exists($files{lc($file)});

   978                 next if ($file !~ s/\.[0-9a-f]{32}\./\./i);

   979                 $file .= ".vmap";

   980                 $files{lc($file)} = $file if !exists($files{lc($file)});

   981             }

   982             close(FILE);

   983         }

   984 

   985         my ($plugfile, $patched) = (0, 0);

   986         foreach $file (Find($dir, $pluglog, "", 1, 0, $_)) {

   987             OpenFile(*FILE, $file, 0) or warn("Can't read file `$file'.\n"), last;

   988             while (<FILE>) {

   989                 $plugfile = 1, next if /^Reading (ROM|ROFS1|UDEB|UREL) files$/;

   990                 $plugfile = 0, next if ($plugfile && /^Found \d+ entries$/);

   991                 if ($plugfile) {

   992                     next if !/`(.+)'$/;

   993                     $file = GetAbsFname($1);

   994                     $files{lc($file)} = $file if !exists($files{lc($file)});

   995                     next;

   996                 }

   997                 $patched = $1, next if /^Found (\d+) ROM-patched components:$/;

   998                 next if (!$patched || !/^`(.+)'$/);

   999                 $patched--;

  1000                 $file = GetAbsFname($1) . ".map";

  1001                 $files{lc($file)} = $file, next if -f($file);

  1002                 $file =~ s/(\..*?\.map)$/\.\*$1/;

  1003                 foreach (glob($file =~ /\s/ ? "\"$file\"" : $file)) {

  1004                     ($file = lc()) =~ s/\.map$//;

  1005                     $files{lc()} = $_, last if exists($files{$file});

  1006                 }

  1007             }

  1008             close(FILE);

  1009         }

  1010 

  1011         $dir .= "/" if $dir !~ /\/$/;

  1012         foreach $file (keys(%files)) {

  1013             delete($files{$file}) if ($file =~ /^$dir/i);

  1014         }

  1015     }

  1016 

  1017     @gFindresult = () if (!defined($opt) || $opt !~ /a/);

  1018     push(@gFindresult, values(%files));

  1019 }

  1020 

  1021 

  1022 ###############################################################################

  1023 #

  1024 

  1025 sub CheckTool(@)

  1026 {

  1027     return if $gPrintcmd;

  1028     my ($maxtlen, $maxvlen, @tools) = (4, 9, ());

  1029     while (@_) {

  1030         my ($tool, $vquery, $getver, $version, $md5sum) = (shift(), shift(), shift(), " -", " ?");

  1031         if (length($vquery) > 1) {

  1032             RunSystemCmd($vquery, "null");

  1033             $version = (join("\n", @gCmdoutbuf) =~ eval($getver =~ /^\// ? "qr$getver" : "qr/$getver/ims") ?

  1034                 (defined($1) && defined($2) && "`$1 $2'" || defined($1) && "`$1'" || " ?") : " ?");

  1035         }

  1036         OpenFile(*FILE, $tool, 1) and $md5sum = "`" . md5_hex(<FILE>) . "'";

  1037         close(FILE);

  1038         $maxtlen = Max($maxtlen, length($tool));

  1039         $maxvlen = Max($maxvlen, length($version));

  1040         push(@tools, "`$tool'", $version, $md5sum);

  1041     }

  1042     $maxtlen += 2;

  1043     @_ = (" Tool", " Version", " MD5 Checksum", "-" x $maxtlen, "-" x $maxvlen, "-" x 34, @tools);

  1044     DPrint(1, sprintf("%-${maxtlen}s %-${maxvlen}s ", shift(), shift()) . shift() . "\n") while(@_);

  1045 }

  1046 

  1047 

  1048 ###############################################################################

  1049 #

  1050 

  1051 sub GetIPar()

  1052 {

  1053     local $_ = shift(@gIcmd);

  1054     $_ = "<UNDEFINED>" if (my $empty = !defined());

  1055 

  1056     while (/\@PEVAL{.*}LAVEP\@/) {

  1057         my $start = rindex($_, '@PEVAL{', my $end = index($_, '}LAVEP@') + 7);

  1058         my ($expr, $eval, $evalerr) = (substr($_, $start + 7, $end - $start - 14), undef, "");

  1059         eval {

  1060             local ($_, $SIG{__DIE__});

  1061             local $SIG{__WARN__} = sub{} if $gPrintcmd;

  1062             $eval = eval($expr);

  1063             ($evalerr = $@) =~ s/^(.+?) at .*/$1/s;

  1064         };

  1065 #        DPrint(64, "GetIPar: Evaluate `$expr' = `" . (defined($eval) ? $eval : "") . "'\n");

  1066         if (!defined($eval)) {

  1067             $eval = "";

  1068             warn("GetIPar: Evaluation `$expr' failed: $evalerr.\n") if !$gPrintcmd;

  1069         }

  1070         substr($_, $start, $end - $start) = $eval;

  1071     }

  1072     DPrint(32, "iPar: $gParamcnt. `$_'\n") if $gParamcnt;

  1073     $gParamcnt++;

  1074     return($empty ? undef : $_);

  1075 }

  1076 

  1077 sub PeekICmd($)

  1078 {

  1079     return(defined($gIcmd[0]) && $gIcmd[0] =~ /^$_[0]$/i);

  1080 }

  1081 

  1082 sub GetICmd()

  1083 {

  1084     $gParamcnt = 0;

  1085     my $cmd = GetIPar();

  1086     DPrint(32, "iCmd: " . ++$gCmdcnt . ". `$cmd'\n") if defined($cmd) && $cmd ne "";

  1087     return($cmd);

  1088 }

  1089 

  1090 sub EndICmd()

  1091 {

  1092     GetICmd(), return(1) if !defined($gIcmd[0]) || PeekICmd("end");

  1093     return(0);

  1094 }

  1095 

  1096 sub RunICmd()

  1097 {

  1098     my ($cmd, $file, $iferror) = ("", "", 0);

  1099     while (defined($cmd = GetICmd())) {

  1100         next if $cmd eq "";

  1101         local $_ = lc($cmd);

  1102         if (/^(error|warning)$/) {

  1103             my ($errwarn, $msg) = (GetIPar(), Unquote(GetIPar()));

  1104             die($msg)  if $errwarn && /e/;

  1105             warn($msg) if $errwarn && /w/;

  1106         }

  1107         elsif (/^echo(\d+)?(-q)?$/) {

  1108             my ($verbose, $quote) = (defined($1) && ($1 < 128) ? $1 : 1, defined($2));

  1109             Echo($verbose, GetIPar(), $quote);

  1110         }

  1111         elsif (/^filter$/) {

  1112             $gOutfilter = GetIPar();

  1113         }

  1114         elsif (/^cmd(tee)?$/) {

  1115             $file = $1;

  1116             RunSystemCmd(GetIPar(), $file ? GetIPar() : "");

  1117         }

  1118         elsif (/^parse(f)?$/) {

  1119             $file = $1;

  1120             ParseSystemCmd(GetIPar(), GetIPar(), $file);

  1121         }

  1122         elsif (/^(cd|copy(dir)?|del(dir)?|find(dir)?(-[ar]+)?|headb|logfile|mkcd|mkdir|move|tailb|test|touch|type[bu]?|unzip|workdir|write[bu]?(-q)?|zip(dir)?(-[jq]+)?)$/) {

  1123             my @files = GlobFiles(GetIPar());

  1124             my $par1 = GetIPar() if /^(?:copy|find|head|move|tail|touch|(un)?zip|write)/;

  1125             my $par2 = GetIPar() if /^(?:find|head|tail|zip)/;

  1126             next if $gPrintcmd;

  1127             foreach $file (@files) {

  1128                 ChangeDir($file)                           if /^cd/;

  1129                 DeleteDir($file)                           if /deldir/;

  1130                 FindDir($file, $par1, $par2, $1)           if /finddir(-[ar]+)?/;

  1131                 MakeDir($file)                             if /mkdir/;

  1132                 MakeChangeDir($file)                       if /mkcd/;

  1133                 SetWorkdir($file)                          if /workdir/;

  1134                 Zip($file, 1, $1, $par2, GlobFiles($par1)) if /zipdir(-[jq]+)?/;