This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_save_alloc can use the new(er) SSGROW rather than looping.
[perl5.git] / symbian / makesis.pl
1 #!/usr/bin/perl -w
2
3 # Copyright (c) 2004-2005 Nokia.  All rights reserved.
4
5 use strict;
6 use lib "symbian";
7
8 do "sanity.pl";
9
10 my %VERSION = %{ do "version.pl" };
11 my $VERSION = "$VERSION{REVISION}$VERSION{VERSION}$VERSION{SUBVERSION}";
12 my $R_V_SV  = "$VERSION{REVISION}.$VERSION{VERSION}.$VERSION{SUBVERSION}";
13
14 my ($SYMBIAN_ROOT, $SYMBIAN_VERSION, $SDK_NAME, $SDK_VARIANT, $SDK_VERSION) =
15     @{ do "sdk.pl" };
16 my $UID  = do "uid.pl";
17 my %PORT = %{ do "port.pl" };
18
19 my $ARM = 'thumb'; # TODO
20 my $S60SDK = $ENV{S60SDK}; # from sdk.pl
21 my $S80SDK = $ENV{S80SDK}; # from sdk.pl
22
23 my $UREL = $ENV{UREL}; # from sdk.pl
24 $UREL =~ s/-ARM-/$ARM/;
25
26 my $app = '!:\System\Apps\Perl';
27 my $lib = '!:\System\Libs';
28
29 my @target = @ARGV
30   ? @ARGV
31   : (
32     "miniperl",          "perl",
33     "perl${VERSION}dll", "perl${VERSION}lib",
34     "perl${VERSION}ext"
35   );
36
37 my %suffix;
38 @suffix{ "miniperl", "perl", "perl$VERSION" } = ( "exe", "exe", "dll", );
39
40 for my $target (@target) {
41     $target = "perl${VERSION}" if $target eq "perl${VERSION}dll";
42
43     my %copy;
44     my $pkg = "$target.pkg";
45     print "\nCreating $pkg...\n";
46
47     my $suffix = $suffix{$target} || "";
48     my $dst = $suffix eq "dll" ? $lib : $app;
49
50     my $srctarget = "$UREL\\$target.$suffix";
51
52     if ( $target =~ /^(miniperl|perl|perl${VERSION}(?:dll)?)$/ ) {
53         $copy{$srctarget} = "$dst\\$target.$suffix";
54         print "\t$target.$suffix\n";
55     }
56     if ( $target eq "perl${VERSION}lib" ) {
57         print "Libraries...\n";
58
59         print "\tConfig.pm\n";
60         $copy{"lib\\Config.pm"} =
61           "$lib\\Perl\\$R_V_SV\\thumb-symbian\\Config.pm";
62
63         print "\tConfig_heavy.pl\n";
64         $copy{"xlib\\symbian\\Config_heavy.pl"} =
65           "$lib\\Perl\\$R_V_SV\\thumb-symbian\\Config_heavy.pl";
66
67         print "\tDynaLoader.pm\n";
68         $copy{"ext\\DynaLoader\\DynaLoader.pm"} =
69           "$lib\\Perl\\$R_V_SV\\DynaLoader.pm";
70
71         print "\tErrno.pm\n";
72         $copy{"ext\\Errno\\Errno.pm"} = "$lib\\Perl\\$R_V_SV\\Errno.pm";
73
74         open( my $cfg, "symbian/install.cfg" )
75           or die "$!: symbian/install.cfg: $!\n";
76         while (<$cfg>) {
77             next unless /^lib\s+(.+)/;
78             chomp;
79             my $f = $1;
80             unless (-f "lib/$f") {
81                 warn qq[$0: No "lib/$f", skipping...\n];
82                 next;
83             }
84             $f =~ s:/:\\:g;
85             $copy{"lib\\$f"} = "$lib\\Perl\\$R_V_SV\\$f";
86             print "\t$f\n";
87         }
88         close($cfg);
89     }
90
91     if ( $target eq "perl${VERSION}ext" ) {
92         my @lst = glob("symbian/*.lst");
93         print "Extensions...\n";
94         print "\t(none found)\n" unless @lst;
95         for my $lst (@lst) {
96             $lst =~ m:^symbian/(.+)\.:;
97             my $ext = $1;
98             $ext =~ s!-!::!g;
99             print "\t$ext\n";
100             if ( open( my $pkg, $lst ) ) {
101                 while (<$pkg>) {
102                     if (m!^"(.+)"-"(.+)"$!) {
103                         my ( $src, $dst ) = ( $1, $2 );
104                         $copy{$src} = $dst;
105                     }
106                     else {
107                         warn "$0: $lst: $.: unknown syntax\n";
108                     }
109                 }
110                 close($pkg);
111             }
112             else {
113                 warn "$0: $lst: $!\n";
114             }
115         }
116     }
117
118     for my $file ( keys %copy ) {
119         warn "$0: $file does not exist\n" unless -f $file;
120     }
121
122     my @copy = map { qq["$_"-"$copy{$_}"] } sort keys %copy;
123     my $copy = join( "\n", @copy );
124
125     my %UID = (
126         "miniperl"          => 0,
127         "perl"              => 0,
128         "perl${VERSION}"    => $UID + 0,
129         "perl${VERSION}dll" => $UID + 0,
130         "perl${VERSION}ext" => $UID + 1,
131         "perl${VERSION}lib" => $UID + 2,
132         "perlapp"           => $UID + 3,
133         "perlrecog"         => $UID + 4,
134         "perlappmin"        => $UID + 5,
135     );
136
137     die "$0: target has no UID\n" unless defined $UID{$target};
138
139     my $uid = sprintf( "0x%08X", $UID{$target} );
140
141     my ( $MAJOR, $MINOR, $PATCH ) = ( 0, 0, 0 );
142
143     if ( $target =~ m:^perl$VERSION(dll|ext|lib)?$: ) {
144         my $pkg = defined $1 ? $1 : "dll";
145         $MAJOR = $PORT{$pkg}->{MAJOR};
146         $MINOR = $PORT{$pkg}->{MINOR};
147         $PATCH = $PORT{$pkg}->{PATCH};
148     }
149
150     die "$0: Bad version for $target\n"
151       unless defined $MAJOR
152       && ( $MAJOR eq 0 || $MAJOR > 0 )
153       && defined $MINOR
154       && ( $MINOR eq 0 || $MINOR > 0 )
155       && defined $PATCH
156       && ( $PATCH eq 0 || $PATCH > 0 );
157
158      my $ProductId =
159          defined $S60SDK ?
160 qq[;Supports Series 60 v0.9\n(0x101F6F88), 0, 0, 0, {"Series60ProductID"}\n] :
161          defined $S80SDK ?
162 qq[;Supports Series 80 v2.0\n(0x101F8ED2), 0, 0, 0, {"Series80ProductID"}\n] :
163          ";Supports Series NN";
164
165     open PKG, ">$pkg" or die "$0: failed to create $pkg: $!\n";
166     print PKG <<__EOF__;
167 ; \u$target installation script
168 ;
169 ; The supported languages
170 &EN;
171 ;
172 ; The installation name and header data
173 ;
174 #{"\u$target"},($uid),$MAJOR,$MINOR,$PATCH
175 ;
176 ; Private key and certificate (unused)
177 ;
178 ;* "\u$target.key", "\u$target.cer"
179 ;
180 $ProductId
181 ; The files to install
182 ;
183 $copy
184 __EOF__
185     close PKG;
186
187     print "Created $pkg\n";
188
189     print "Running makesis...\n";
190
191     unlink("$target.sis");
192
193     system("makesis $pkg") == 0
194       || die "$0: makesis $pkg failed: $!\n";
195 }
196
197 exit(0);