#!/usr/bin/perl -w

#
# sisify.pl - package Perl scripts or Perl libraries into SIS files
#
# Copyright (c) 2004-2005 Nokia. All rights reserved.
# The sisify.pl utility is licensed under the same terms as Perl itself.
#

require 5.008;

use strict;

use vars qw($VERSION);

$VERSION = '0.2';

use Getopt::Long;
use File::Temp qw/tempdir/;
use File::Find;
use File::Basename qw/basename dirname/;
use Cwd qw/getcwd/;

BEGIN {
  # This utility has been developed in Windows under cmd.exe with
  # the Series 60 2.6 SDK installed, but for the makesis utility
  # in UNIX/Linux, try e.g. one of the following:
  # http://gnupoc.sourceforge.net/
  # http://symbianos.org/~andreh/ You
  # will also need the 'uidcrc' utility.
  die "$0: Looks like Cygwin, aborting.\n" if exists $ENV{'!C:'};
}

sub die_with_usage {
  if (@_) {
    warn "$0: $_\n" for @_;
  }
  die <<__USAGE__;
$0: Usage:
$0 [--variant=S60|S80|UIQ] [ --uid=hhhhhhhh ] [ --version=a.b.c ] [ --library=x.y.z ] [ some.pl | Some.pm | somefile | dir ... ]
The uid is the Symbian app uid for the SIS.
The version is the version of the SIS.
The library is the version of Perl under which to install.  If using this,
only specify directories for packaging.
__USAGE__
}

my $SisUid;
my $SisVersion;
my $Library;
my @SisPl;
my @SisPm;
my @SisDir;
my @SisOther;
my $AppName;
my $Debug;
my $ShowPkg;
my $Variant;

my $SisUidDefault     = 0x0acebabe;
my $SisVersionDefault = '0.0.0';
my $VariantDefault    = 'S60';

my %Variant = qw(S60 1 S80 1 UIQ 1);

die_with_usage()
  unless GetOptions(
		    'variant=s'		=> \$Variant,
		    'uid=s'		=> \$SisUid,
		    'version=s'		=> \$SisVersion,
		    'debug'		=> \$Debug,
		    'showpkg'		=> \$ShowPkg,
		    'library=s'		=> \$Library,
		    'appname=s'		=> \$AppName,
		   );
die_with_usage("Need to specify what to sisify")
  unless @ARGV;

unless (defined $Variant) {
  warn "$0: Defaulting to $VariantDefault\n";
  $Variant = $VariantDefault;
}

unless (exists $Variant{$Variant}) {
  die "$0: Unknown variant '$Variant'\n";
}

for my $i (@ARGV) {
  if ($i =~ /\.pl$/i) {
    push @SisPl, $i;
  } elsif ($i =~ /\.pm$/i) {
    push @SisPm, $i;
  } elsif (-f $i) {
    push @SisOther, $i;
  } elsif (-d $i) {
    push @SisDir, $i;
  } else {
    die_with_usage("Unknown sisifiable '$i'");
  }
}

sub do_system {
    my $cwd = getcwd();
    print qq{\# system("@_") [cwd "$cwd"]\n};
    return system("@_") == 0;
}

die_with_usage("Must specify something to sisify")
  unless @SisPl || @SisPm || @SisOther || @SisDir;

die_with_usage("With the lib option set, specify only directories")
  if defined $Library && ((@SisPl || @SisPm || @SisOther) || @SisDir == 0);

die_with_usage("Lib must define the Perl 5 version as 5.x.y")
  if defined $Library && $Library !~ /^5.\d+\.\d+$/;

die_with_usage("With the lib option unset, specify at least one .pl file")
  if (! defined $Library && @SisPl == 0);

if (!defined $AppName) {
  if (defined $Library) {
    $AppName = $SisDir[0];
    $AppName =~ tr!/!-!;
  } elsif (@SisPl > 0 && $SisPl[0] =~ /^(.+)\.pl$/i) {
    $AppName = basename($1);
  }
}

die_with_usage("Must either specify appname or at least one .pl file or the lib option")
  unless defined $AppName || defined $Library;

print "[app name '$AppName']\n" if $Debug;

unless (defined $SisUid) {
  $SisUid = $SisUidDefault;
  printf "[default app uid '0x%08x']\n", $SisUid;
} elsif ($SisUid =~ /^(?:0x)?([0-9a-f]{8})$/i) {
  $SisUid = hex($1);
} else {
  die_with_usage("Bad uid '$SisUid'");
}
$SisUid = sprintf "0x%08x", $SisUid;

die_with_usage("Bad uid '$SisUid'")
  if $SisUid !~ /^0x[0-9a-f]{8}$/i;

unless (defined $SisVersion) {
  $SisVersion = $SisVersionDefault;
  print "[default app version '$SisVersionDefault']\n";
} elsif ($SisVersion !~ /^\d+\.\d+\.\d+$/) {
  die_with_usage("Bad version '$SisVersion'")
}

my $tempdir = tempdir( CLEANUP => 1 );

print "[temp directory '$tempdir']\n" if $Debug;

for my $file (@SisPl, @SisPm, @SisOther) {
  print "[copying file '$file']\n" if $Debug;
  die_with_usage("$0: File '$file': $!") unless -f $file;
  my $dir = dirname($file);
  do_system("mkdir $tempdir\\$dir") unless $dir eq '.';
  do_system("copy $file $tempdir");
}
if (@SisPl) {
    do_system("copy $SisPl[0] $tempdir\\default.pl")
	unless $SisPl[0] eq "default.pl";
}
for my $dir (@SisDir) {
  print "[copying directory '$dir']\n" if $Debug;
  do_system("copy $dir $tempdir");
}

my $SisVersionCommas = $SisVersion;

$SisVersionCommas =~ s/\./\,/g;

my @pkg;

push @pkg, qq[&EN;];
push @pkg, qq[#{"$AppName"},($SisUid),$SisVersionCommas];
push @pkg, qq[(0x101F6F88), 0, 0, 0, {"Series60ProductID"}];

my $OWD = getcwd();

$OWD =~ s!/!\\!g;

chdir($tempdir) or die "$0: chdir('$tempdir')\n";

if (@SisPl) {
  if (open(my $fi, "default.pl")) {
    my $fn = "default.pl.new";
    if (open(my $fo, ">$fn")) {
      while (<$fi>) {
	last unless /^\#/;
	print $fo $_;
      }
      print $fo "use lib qw(\\system\\apps\\$AppName \\system\\apps\\$AppName\\lib);\n";
      printf $fo qq[# %d "$SisPl[0]"\n], $.;
      print $fo $_;
      while (<$fi>) {
	print $fo $_;
      }
      close($fo);
    } else {
      die "$0: open '>$fn': $!\n";
    }
    close($fi);
    rename($fn, "default.pl") or die "$0: rename $fn default.pl: $!\n";
    # system("cat -nvet default.pl");
  } else {
    die "$0: open 'default.pl': $!\n";
  }
}


my @c;
find(
     sub {
       if (-f $_) {
	 $File::Find::name =~ s!^\./!!;
	 push @c, $File::Find::name;
       }
     }
     ,
     ".");

for my $i (sort @c) {
  my $j = $i;
  $j =~ s!/!\\!g;
  push @pkg, defined $Library ? qq["$j"-"!:\\System\\Libs\\Perl\\siteperl\\$Library\\$j"] : qq["$j"-"!:\\system\\apps\\$AppName\\$j"];
}

sub hex2data {
  pack("H*", shift); # symbian\hexdump.pl to create the hexdumps.
}

my $APPHEX;
my $RSCHEX;

unless ($Library) {
  # If we package an application we will need both a launching native
  # Symbian application and a resource file for it.  The resource file
  # we can get easily from a stub but for the native app we need to
  # patch in the right Symbian app uids and executable checksums.

  &init_hex; # Initialized $APPHEX and $RSCHEX.

  die "$0: No app template found\n" unless defined $APPHEX && defined $RSCHEX;

  my $app = hex2data($APPHEX);
  my $uidcrc;
  my $uids = "0x10000079 0x100039CE $SisUid";

  my $cmd = "uidcrc $uids |";

  if (open(my $fh, $cmd)) {
    my $line = <$fh>;
    close($fh);
    # 0x10000079 0x100039ce 0x0acebabe 0xc82b1900
    $line =~ s/\r?\n$//;
    if ($line =~ /^$uids (0x[0-9a-f]{8})$/i) {
      $uidcrc = hex($1);
    } else {
      die "$0: uidcrc returned '$line'\n";
    }
  } else {
    die qq[$0: open '$cmd' failed: $!\n];
  }

  my $uid    = hex($SisUid);

  my $oldchk = unpack('V', substr($app, 24, 4));
  my $newchk = ($uid + $oldchk) & 0xFFFFFFFF;

  # printf "# uid    = 0x%08x\n", $uid;
  # printf "# uidcrc = 0x%08x\n", $uidcrc;
  # printf "# oldchk = 0x%08x\n", $oldchk;
  # printf "# newchk = 0x%08x\n", $newchk;

  substr($app,  8, 4) = pack('V', $uid);
  substr($app, 12, 4) = pack('V', $uidcrc);
  substr($app, 24, 4) = pack('V', $newchk);
  
  my $UID_OFFSET = 0x0C7C; # This is where the uid is in the $app.
  substr($app, $UID_OFFSET, 4) = substr($app, 8, 4); # Copy the uid also here.

  if (open(my $fh, ">$AppName.app")) {
    binmode($fh);
    print $fh $app;
    close($fh);
  } else {
    die qq[$0: open '>$AppName.app' failed: $!\n];
  }

  push @pkg, qq["$AppName.app"-"!:\\system\\apps\\$AppName\\$AppName.app"];

  if (open(my $fh, ">$AppName.rsc")) {
    binmode($fh);
    print $fh hex2data($RSCHEX);
    close($fh);
  } else {
    die qq[$0: open '>$AppName.rsc' failed: $!\n];
  }
  push @pkg, qq["$AppName.rsc"-"!:\\system\\apps\\$AppName\\$AppName.rsc"];
}

if ($ShowPkg) {
  for my $l (@pkg) {
    print $l, "\r\n";
  }
} else {
  my $fn = "$AppName.pkg";
  if (open(my $fh, ">$fn")) {
    for my $l (@pkg) {
      print $fh "$l\r\n"; # Note CRLF!
    }
    close($fh);
  } else {
    die qq[$0: Failed to open "$fn" for writing: $!\n];
  }
  my $sis = "$AppName.SIS";
  unlink($sis);
  do_system("dir");
  do_system("makesis $fn");
  unless (-f $sis) {
    die qq[$0: failed to create "$sis"\n];
  }
  do_system("copy $AppName.sis $OWD");
  chdir($OWD);
  system("dir $sis");
  print "\n=== Now transfer $sis to your device ===\n";
}

exit(0);

# To create the hex: print unpack("H*", $data);

sub init_hex {
  # This is Symbian application executable skeleton.
  # You can create the ...\epoc32\release\thumb\urel\foo.app
  # by compiling the PerlApp.cpp with PerlMinSample defined in PerlApp.h.
  # The following executable has been compiled using the Series 60 SDK 2.6
  # for Visual C.
  # 'make sisify_hex' to create the perlappmin.hex for this hexdump.
  if ($Variant eq 'S60') {
      $APPHEX = <<__APP__;
[encoded data, 24720 characters]
__APP__
  }

  # This is Symbian application resource skeleton.
  # You can create the ...\epoc32\data\z\system\apps\PerlApp\PerlApp.rsc
  # by compiling the PerlApp.cpp.
  # The following resource has been compiled using the Series 60 SDK 2.6
  # for Visual C.
  # 'make sisify_hex' to create the perlrscmin.hex for this hexdump.
  if ($Variant eq 'S60') {
    $RSCHEX = <<__RSC__;
6b4a1f10000000005fde04001ca360de01b80010000400000001f0e54d0000000004f0e54d00000000000000001a00cc0800000000010005f0e54d000000000000ffffffff0000000000000000000f0500000400000000000000000000050541626f7574170000ffffffff00000000010400000000000000000000040454696d65170000ffffffff00000000020400000000000000000000030352756e170000ffffffff0000000003040000000000000000000008084f6e656c696e6572170000ffffffff000000000404000000000000000000000909436f707972696768740e0000ffffffff00000000000000000120000000000000001400cc0801006816000100000000000100000000ffffffff00ffffffff0000000000000000ffff000000000000000120000000000000002400cc0801006816000100000000000100000000ffffffff00ffffffff0000000000000000ffff000000000000004122000000000000001400cc08010069160000050000000001000000000000000001000000040007000800ff020100ffffffff00000000000000000000ffff000000000000004122000000000000001400cc08010074160007000000000054160000ffffffff000000000000ffff00000000000000000000000015001d001d0035004d00ef0026015d01a301d201d701
__RSC__
  }

  # This is Symbian application executable skeleton.
  # You can create the ...\epoc32\release\thumb\urel\foo.app
  # by compiling the PerlApp.cpp with PerlMinSample defined in PerlApp.h.
  # The following executable has been compiled using the Series 80 SDK 2.0
  # for Visual C.
  # 'make sisify_hex' to create the perlappmin.hex for this hexdump.
  if ($Variant eq 'S80') {
      $APPHEX = <<__APP__;
[encoded data, 22751 characters]
  }

  # This is Symbian application resource skeleton.
  # You can create the ...\epoc32\data\z\system\apps\PerlApp\PerlApp.rsc
  # by compiling the PerlApp.cpp.
  # The following resource has been compiled using the Series 80 SDK 2.0
  # for Visual C.
  # 'make sisify_hex' to create the perlrscmin.hex for this hexdump.
  if ($Variant eq 'S80') {
    $RSCHEX = <<__RSC__;
6b4a1f10000000005fde04001ca360de01b800780400000001f0e54d0000000005f0e54d000000000000000004f0e54d000000000010010000005000000000000400000204030352756e0900ffffffff00030408084f6e656c696e65720900ffffffff000504050541626f75740900ffffffff0000010404457869740500ffffffff0007010006f0e54d07074f7074696f6e73110000000000ffffffff0000000000000000000f0500000400000000000000000000050541626f7574170000ffffffff00000000010400000000000000000000040454696d65170000ffffffff00000000020400000000000000000000030352756e170000ffffffff0000000003040000000000000000000008084f6e656c696e6572170000ffffffff000000000404000000000000000000000909436f707972696768740e0000ffffffff00000000000000000003010005055469746c65110000000064b0f3000000000001000200060650726f6d70740f00080000000000000a00010080000014001c001c0034008200a50047017b01
__RSC__
  }

  # This is Symbian application executable skeleton.
  # You can create the ...\epoc32\release\thumb\urel\foo.app
  # by compiling the PerlApp.cpp with PerlMinSample defined in PerlApp.h.
  # The following executable has been compiled using the UIQ SDK 2.1
  # for CodeWarrior.
  # 'make sisify_hex' to create the perlappmin.hex for this hexdump.
  if ($Variant eq 'UIQ') {
      $APPHEX = <<__APP__;
[encoded data, 22792 characters]
__APP__
  }

  # This is Symbian application resource skeleton.
  # You can create the ...\epoc32\data\z\system\apps\PerlApp\PerlApp.rsc
  # by compiling the PerlApp.cpp.
  # The following resource has been compiled using the UIQ 2.1 SDK
  # for CodeWarrior.
  # 'make sisify_hex' to create the perlrscmin.hex for this hexdump.
  if ($Variant eq 'UIQ') {
    $RSCHEX = <<__RSC__;
6b4a1f10000000005fde04001ca360de019a00f8030400000001f0e54d0000000004f0e54d04f0e54d0000000000000000000000000007010005f0e54d07074f7074696f6e73110000000000ffffffff0000000000000000000f0400000400000000000000000000050541626f7574170000ffffffff00000000010400000000000000000000040454696d65170000ffffffff0000000003040000000000000000000008084f6e656c696e6572170000ffffffff000000000404000000000000000000000909436f707972696768740e0000ffffffff000000000000000000050100000005055469746c6511460014000000000064b0f30001000200060650726f6d707411000800000000000000000a0001008000000005000000000d0d4f4b202f2043616e63656c203f0e460014000000000008f0e54d00000015010000000200feff00000000000000000000000002024f6b1a00ffffffff000000000101ffff000000000000000000000000060643616e63656c0b00ffffffff0000000001010005000000000a0a596573202f204e6f203f0e46001400000000000af0e54d00000015010000000200feff00000000000000000000000003035965732900ffffffff000000000101ffff000000000000000000000000024e006f0000ffffffff00000000010115001d001d0035005800de0016013a018201a301e801
__RSC__
  }
}
