#

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

# All rights reserved.

# This component and the accompanying materials are made available

# which accompanies this distribution, and is available

#

# Initial Contributors:

# Nokia Corporation - initial contribution.

#

# Contributors:

#

# Description: iMaker common Perl routines

#

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

package imaker;

use strict;

use warnings;

use Archive::Zip qw(:ERROR_CODES);

use Archive::Zip::Tree;

use Cwd;

use Digest::MD5 qw(md5_hex);

use File::Basename;

use File::Copy;

use File::Find;

use File::Path;

use File::Spec;

use POSIX qw(strftime);

use Time::Local;

use XML::Simple;

sub Max(@);

sub Min(@);

sub Quote($);

sub Unquote($);

sub Byte2Str($@);

sub Str2Byte($);

sub Str2Xml($);

sub Ascii2Uni($);

sub Uni2Ascii($);

sub GetTimestamp();

sub Sec2Min($);

sub Wcard2Restr($);

sub Wcard2Regex($);

sub DPrint($@);

sub Echo($$$);

sub PathConv($;$$);

sub ParseFiles($);

sub GlobFiles($);

sub GetBasename($);

sub GetDirname($);

sub GetAbsDirname($;$$);

sub GetAbsFname($;$$);

sub GetRelFname($;$$$);

sub GetWriteFname($);

sub GetFreeDrive();

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

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

sub ChangeDir($);

sub DeleteDir($;$);

sub FindDir($$$$);

sub MakeDir($);

sub MakeChangeDir($);

sub SetWorkdir($);

sub OpenFile(*$$;$);

sub Test($);

sub CutFile($$$$$);

sub Copy($$;$);

sub DeleteFile($;$);

sub FindFile($$$$);

sub HeadFile($$$);

sub TailFile($$$);

sub TypeFile($;$);

sub WriteFile($$$;$);

sub UnzipFile($$);

sub Zip($$$$@);

sub Move($$);

sub Touch($$);

sub SetLogfile($);

sub WidgetUnzip($$$);

sub RunSystemCmd($$;$);

sub ParseSystemCmd($$$);

sub GenExclfile($$$$$);

sub GenIbyfile($$$@);

sub GenMakefile($$$$$);

sub AddImageHeader($$$$$);

sub Sleep($);

sub FindSOSFiles($$$$$);

sub CheckTool(@);

sub GetIPar();

sub PeekICmd($);

sub GetICmd();

sub EndICmd();

sub RunICmd();

sub RunIExtCmd($);

sub GetFeatvarIncdir($;$);

sub SetVerbose($);

sub ReadICmdFile($);

sub CloseLog();

sub MakeStep($$$$$$);

sub HandleCmdArg($);

sub HandleExtCmdArg($);

sub MenuRuncmd($);

sub Menu($$$);

use constant READBUFSIZE => 2097152;  # 2 MB

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

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

our $gBuflog     = 1;

our $gCmdcnt     = 0;

our @gCmdoutbuf  = ();

our $gEpoc32;

our @gFindresult = ();

our $gError      = 0;

our @gIcmd       = ();

our $gImakerext  = 0;

our $gKeepgoing  = 0;

our @gLogbuf     = ();

our $gLogfile    = "";

our $gMakestep   = "";

our $gOutfilter  = "";

our $gParamcnt   = 0;

our $gPrintcmd   = 0;

our @gStepDur    = ();

our %gStepIcmd   = ();

our $gVerbose    = 1;

our $gWarn       = 0;

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

our $gWorkdir    = "";

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

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

BEGIN {

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

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

    eval { require featurevariantparser };

}

###############################################################################

#

sub Max(@)

{

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

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

    return($max);

}

sub Min(@)

{

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

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

    return($min);

}

sub Quote($)

{

    local $_ = shift();

    return("") if !defined();

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

    return($_);

}

sub Unquote($)

{

    local $_ = shift();

    return("") if !defined();

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

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

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

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

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

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

    s/\x00//g;

    return($_);

}

sub Byte2Str($@)

{

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

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

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

}

sub Str2Byte($)

{

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

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

    map {

        $ind++;

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

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

            push(@byte, $_);

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

            push(@byte, hex());

        } else {

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

            return;

        }

    } split(/,/, $str);

    return(@byte);

}

sub Str2Xml($)

{

    my $str = shift();

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

    return($str);

}

sub Ascii2Uni($)

{

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

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

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

}

sub Uni2Ascii($)

{

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

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

    return(substr($_, 2));

}

sub GetTimestamp()

{

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

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

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

}

sub Sec2Min($)

{

    my $sec = shift();

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

}

sub Wcard2Restr($)

{

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

    return($wcard);

}

sub Wcard2Regex($)

{

    my $restr = Wcard2Restr(shift());

    return(qr/$restr/i);

}

###############################################################################

#

sub DPrint($@)

{

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

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

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

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

    return if $gBuflog && !$gLogfile;

    print(LOG @gLogbuf) if $gBuflog;

    @gLogbuf = ();

}

sub Echo($$$)

{

    return if $gPrintcmd;

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

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

}

###############################################################################

#

# Overload die

*CORE::GLOBAL::die = sub {

    $gError = 1;

    return if PeekICmd("iferror");

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

    warn(@_);

};

# Handler for __DIE__ signal

$SIG{__DIE__} = sub {

    select(STDERR);

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

    select(STDOUT);

    exit(1);

};

# Handler for __WARN__ signal

$SIG{__WARN__} = sub {

    select(STDERR);

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

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

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

    select(STDOUT);

    $gError = $gWarn = 0;

};

###############################################################################

# File operations

sub PathConv($;$$)

{

    my $path = shift();

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

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

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

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

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

    return($path);

}

sub ParseFiles($)

{

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

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

    return(@files);

}

sub GlobFiles($)

{

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

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

}

sub GetBasename($)

{

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

}

sub GetDirname($)

{

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

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

}

sub GetAbsDirname($;$$)

{

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

    my $absdir = "";

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

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

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

}

sub GetAbsFname($;$$)

{

    my $file = shift();

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

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

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

}

sub GetRelFname($;$$$)

{

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

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

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

}

sub GetWriteFname($)

{

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

    return($file);

}

sub GetFreeDrive()

{

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

        return("$drive:") if

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

    }

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

}

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

{

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

    my @dir = ();

    map {

        my $isfile = -f();

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

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

            ++$$total;

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

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

        }

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

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

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

}

sub Find($$$$$\$)

{

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

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

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

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

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

        $inclpat = "";

    } else {

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

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

    }

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

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

        $exclpat = "";

    } else {

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

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

    }

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

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

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

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

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

    return(@files);

}

sub ChangeDir($)

{

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

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

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

    }

}

sub DeleteDir($;$)

{

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

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

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

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

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

        return if !-d($dir);

    }

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

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

}

sub FindDir($$$$)

{

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

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

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

}

sub MakeDir($)

{

    my $dir = GetAbsDirname(shift());

    return if -d($dir);

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

    if (-d($dir)) {

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

    } else {

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

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

    }

}

sub MakeChangeDir($)

{

    MakeDir(my $dir = shift());

    ChangeDir($dir);

}

sub SetWorkdir($)

{

    MakeChangeDir(shift());

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

    $gWorkdir   = GetAbsDirname(".");

}

sub OpenFile(*$$;$)

{

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

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

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

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

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

}

sub Test($)

{

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

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

    } elsif (-f($file)) {

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

    } else {

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

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

    }

}

sub CutFile($$$$$)

{

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

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

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

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

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

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

    while ($len > 0) {

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

        print(OUTFILE $buf);

        $len -= READBUFSIZE;

    }

    close(OUTFILE);

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

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