Commit | Line | Data |
2e64bfdb |
1 | use strict; |
2 | use Cwd; |
3 | use File::Path; |
4 | use File::Find; |
5 | |
6 | my %opts = ( |
7 | #defaults |
c96f74ce |
8 | 'verbose' => 1, # verbose level, in range from 0 to 2 |
2e64bfdb |
9 | 'distdir' => 'distdir', |
10 | 'unicode' => 1, # include unicode by default |
11 | 'minimal' => 0, # minimal possible distribution. |
12 | # actually this is just perl.exe and perlXX.dll |
13 | # but can be extended by additional exts |
14 | # ... (as soon as this will be implemented :) |
c96f74ce |
15 | 'cross-name' => 'wince', |
1fa63a09 |
16 | 'strip-pod' => 0, # strip POD from perl modules |
17 | 'adaptation' => 1, # do some adaptation, such as stripping such |
18 | # occurences as "if ($^O eq 'VMS'){...}" for Dynaloader.pm |
c96f74ce |
19 | 'zip' => 0, # perform zip |
2e64bfdb |
20 | 'clean-exts' => 0, |
21 | #options itself |
22 | (map {/^--([\-_\w]+)=(.*)$/} @ARGV), # --opt=smth |
23 | (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV), # --opt --no-opt --noopt |
24 | ); |
25 | |
c96f74ce |
26 | # TODO |
27 | # -- error checking. When something goes wrong, just exit with rc!=0 |
28 | # -- may be '--zip' option should be made differently? |
2e64bfdb |
29 | |
30 | my $cwd = cwd; |
31 | |
32 | if ($opts{'clean-exts'}) { |
33 | # unfortunately, unlike perl58.dll and like, extensions for different |
34 | # platforms are built in same directory, therefore we must be able to clean |
35 | # them often |
36 | unlink '../config.sh'; # delete cache config file, which remembers our previous config |
37 | chdir '../ext'; |
38 | find({no_chdir=>1,wanted => sub{ |
39 | unlink if /((?:\.obj|\/makefile|\/errno\.pm))$/i; |
40 | } |
41 | },'.'); |
42 | exit; |
43 | } |
44 | |
c96f74ce |
45 | # zip |
46 | if ($opts{'zip'}) { |
47 | if ($opts{'verbose'} >=1) { |
48 | print STDERR "zipping...\n"; |
49 | } |
50 | chdir $opts{'distdir'}; |
51 | unlink <*.zip>; |
52 | `zip -R perl-$opts{'cross-name'} *`; |
53 | exit; |
54 | } |
55 | |
2e64bfdb |
56 | my (%libexclusions, %extexclusions); |
57 | my @lfiles; |
58 | sub copy($$); |
59 | |
60 | # lib |
61 | chdir '../lib'; |
62 | find({no_chdir=>1,wanted=>sub{push @lfiles, $_ if /\.p[lm]$/}},'.'); |
63 | chdir $cwd; |
64 | # exclusions |
65 | @lfiles = grep {!exists $libexclusions{$_}} @lfiles; |
66 | #inclusions |
67 | #... |
68 | #copy them |
c96f74ce |
69 | if ($opts{'verbose'} >=1) { |
70 | print STDERR "Copying perl lib files...\n"; |
71 | } |
2e64bfdb |
72 | for (@lfiles) { |
73 | /^(.*)\/[^\/]+$/; |
74 | mkpath "$opts{distdir}/lib/$1"; |
75 | copy "../lib/$_", "$opts{distdir}/lib/$_"; |
76 | } |
77 | |
78 | #ext |
79 | my @efiles; |
80 | chdir '../ext'; |
81 | find({no_chdir=>1,wanted=>sub{push @efiles, $_ if /\.pm$/}},'.'); |
82 | chdir $cwd; |
83 | # exclusions |
84 | #... |
85 | #inclusions |
86 | #... |
87 | #copy them |
88 | #{s[/(\w+)/\1\.pm][/$1.pm]} @efiles; |
c96f74ce |
89 | if ($opts{'verbose'} >=1) { |
90 | print STDERR "Copying perl core extensions...\n"; |
91 | } |
2e64bfdb |
92 | for (@efiles) { |
1fa63a09 |
93 | if (m#^.*?/lib/(.*)$#) { |
94 | copy "../ext/$_", "$opts{distdir}/lib/$1"; |
95 | } |
96 | else { |
97 | /^(.*)\/([^\/]+)\/([^\/]+)$/; |
98 | copy "../ext/$_", "$opts{distdir}/lib/$1/$3"; |
99 | } |
100 | } |
101 | my ($dynaloader_pm); |
102 | if ($opts{adaptation}) { |
103 | # let's copy our Dynaloader.pm (make this optional?) |
104 | open my $fhdyna, ">$opts{distdir}/lib/Dynaloader.pm"; |
105 | print $fhdyna $dynaloader_pm; |
106 | close $fhdyna; |
2e64bfdb |
107 | } |
108 | |
c96f74ce |
109 | # Config.pm, perl binaries |
110 | if ($opts{'verbose'} >=1) { |
111 | print STDERR "Copying Config.pm, perl.dll and perl.exe...\n"; |
112 | } |
113 | copy "../xlib/$opts{'cross-name'}/Config.pm", "$opts{distdir}/lib/Config.pm"; |
114 | copy "$opts{'cross-name'}/perl.exe", "$opts{distdir}/bin/perl.exe"; |
115 | copy "$opts{'cross-name'}/perl.dll", "$opts{distdir}/bin/perl.dll"; |
1fa63a09 |
116 | # how do we know exact name of perl.dll? |
2e64bfdb |
117 | |
118 | # auto |
1fa63a09 |
119 | my %aexcl = (socket=>'Socket_1'); |
120 | # Socket.dll and may be some other conflict with same file in \windows dir |
121 | # on WinCE, %aexcl needed to replace it with a different name that however |
122 | # will be found by Dynaloader |
2e64bfdb |
123 | my @afiles; |
c96f74ce |
124 | chdir "../xlib/$opts{'cross-name'}/auto"; |
2e64bfdb |
125 | find({no_chdir=>1,wanted=>sub{push @afiles, $_ if /\.(dll|bs)$/}},'.'); |
126 | chdir $cwd; |
c96f74ce |
127 | if ($opts{'verbose'} >=1) { |
128 | print STDERR "Copying binaries for perl core extensions...\n"; |
129 | } |
2e64bfdb |
130 | for (@afiles) { |
1fa63a09 |
131 | if (/^(.*)\/(\w+)\.dll$/i && exists $aexcl{lc($2)}) { |
132 | copy "../xlib/$opts{'cross-name'}/auto/$_", "$opts{distdir}/lib/auto/$1/$aexcl{lc($2)}.dll"; |
133 | } |
134 | else { |
135 | copy "../xlib/$opts{'cross-name'}/auto/$_", "$opts{distdir}/lib/auto/$_"; |
136 | } |
2e64bfdb |
137 | } |
138 | |
c96f74ce |
139 | sub copy($$) { |
2e64bfdb |
140 | my ($fnfrom, $fnto) = @_; |
c96f74ce |
141 | open my $fh, "<$fnfrom" or die "can not open $fnfrom: $!"; |
142 | binmode $fh; |
143 | local $/; |
144 | my $ffrom = <$fh>; |
2e64bfdb |
145 | if ($opts{'strip-pod'}) { |
146 | # actually following regexp is suspicious to not work everywhere. |
147 | # but we've checked on our set of modules, and it's fit for our purposes |
148 | $ffrom =~ s/^=\w+.*?^=cut(?:\n|\Z)//msg; |
1fa63a09 |
149 | unless ($ffrom=~/\bAutoLoader\b/) { |
150 | # this logic actually strip less than could be stripped, but we're |
151 | # not risky. Just strip only of no mention of AutoLoader |
152 | $ffrom =~ s/^__END__.*\Z//msg; |
153 | } |
2e64bfdb |
154 | } |
155 | mkpath $1 if $fnto=~/^(.*)\/([^\/]+)$/; |
156 | open my $fhout, ">$fnto"; |
c96f74ce |
157 | binmode $fhout; |
2e64bfdb |
158 | print $fhout $ffrom; |
c96f74ce |
159 | if ($opts{'verbose'} >=2) { |
160 | print STDERR "copying $fnfrom=>$fnto\n"; |
161 | } |
2e64bfdb |
162 | } |
163 | |
164 | BEGIN { |
165 | %libexclusions = map {$_=>1} split/\s/, <<"EOS"; |
166 | abbrev.pl bigfloat.pl bigint.pl bigrat.pl cacheout.pl complete.pl ctime.pl |
167 | dotsh.pl exceptions.pl fastcwd.pl flush.pl ftp.pl getcwd.pl getopt.pl |
168 | getopts.pl hostname.pl look.pl newgetopt.pl pwd.pl termcap.pl |
169 | EOS |
170 | %extexclusions = map {$_=>1} split/\s/, <<"EOS"; |
171 | EOS |
1fa63a09 |
172 | $dynaloader_pm=<<'EOS'; |
173 | # This module designed *only* for WinCE |
174 | # if you encounter a problem with this file, try using original Dynaloader.pm |
175 | # from perl distribution, it's larger but essentially the same. |
176 | package DynaLoader; |
177 | our $VERSION = 1.04; |
178 | |
179 | $dl_debug ||= 0; |
180 | |
181 | @dl_require_symbols = (); # names of symbols we need |
182 | |
183 | #@dl_librefs = (); # things we have loaded |
184 | #@dl_modules = (); # Modules we have loaded |
185 | |
186 | boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && !defined(&dl_error); |
187 | |
188 | print STDERR "DynaLoader not linked into this perl\n" |
189 | unless defined(&boot_DynaLoader); |
190 | |
191 | 1; # End of main code |
192 | |
193 | sub croak{require Carp;Carp::croak(@_)} |
194 | sub bootstrap_inherit { |
195 | my $module = $_[0]; |
196 | local *isa = *{"$module\::ISA"}; |
197 | local @isa = (@isa, 'DynaLoader'); |
198 | bootstrap(@_); |
199 | } |
200 | sub bootstrap { |
201 | # use local vars to enable $module.bs script to edit values |
202 | local(@args) = @_; |
203 | local($module) = $args[0]; |
204 | local(@dirs, $file); |
205 | |
206 | unless ($module) { |
207 | require Carp; |
208 | Carp::confess("Usage: DynaLoader::bootstrap(module)"); |
209 | } |
210 | |
211 | croak("Can't load module $module, dynamic loading not available in this perl.\n") |
212 | unless defined(&dl_load_file); |
213 | |
214 | my @modparts = split(/::/,$module); |
215 | my $modfname = $modparts[-1]; |
216 | my $modpname = join('/',@modparts); |
2e64bfdb |
217 | |
1fa63a09 |
218 | for (@INC) { |
219 | my $dir = "$_/auto/$modpname"; |
220 | next unless -d $dir; |
221 | my $try = "$dir/$modfname.dll"; |
222 | last if $file = ( (-f $try) && $try); |
223 | |
224 | $try = "$dir/${modfname}_1.dll"; |
225 | last if $file = ( (-f $try) && $try); |
226 | push @dirs, $dir; |
227 | } |
228 | $file = dl_findfile(map("-L$_",@dirs,@INC), $modfname) unless $file; |
229 | |
230 | croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)") |
231 | unless $file; |
232 | |
233 | (my $bootname = "boot_$module") =~ s/\W/_/g; |
234 | @dl_require_symbols = ($bootname); |
235 | |
236 | # optional '.bootstrap' perl script |
237 | my $bs = $file; |
238 | $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; |
239 | if (-s $bs) { # only read file if it's not empty |
240 | eval { do $bs; }; |
241 | warn "$bs: $@\n" if $@; |
242 | } |
243 | |
244 | my $libref = dl_load_file($file, 0) or |
245 | croak("Can't load '$file' for module $module: ".dl_error()); |
246 | |
247 | push(@dl_librefs,$libref); # record loaded object |
248 | |
249 | my @unresolved = dl_undef_symbols(); |
250 | if (@unresolved) { |
251 | require Carp; |
252 | Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); |
253 | } |
254 | |
255 | my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or |
256 | croak("Can't find '$bootname' symbol in $file\n"); |
257 | |
258 | push(@dl_modules, $module); |
259 | |
260 | boot: |
261 | my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); |
262 | &$xs(@args); |
263 | } |
264 | |
265 | sub dl_findfile { |
266 | my (@args) = @_; |
267 | my (@dirs, $dir); |
268 | my (@found); |
269 | |
270 | arg: foreach(@args) { |
271 | if (m:/: && -f $_) { |
272 | push(@found,$_); |
273 | last arg unless wantarray; |
274 | next; |
275 | } |
276 | |
277 | if (s:^-L::) {push(@dirs, $_); next;} |
278 | if (m:/: && -d $_) {push(@dirs, $_); next;} |
279 | |
280 | for $dir (@dirs) { |
281 | next unless -d $dir; |
282 | for my $name (/\.dll$/i?($_):("$_.dll",$_)) { |
283 | print STDERR " checking in $dir for $name\n" if $dl_debug; |
284 | if (-f "$dir/$name") { |
285 | push(@found, "$dir/$name"); |
286 | next arg; |
287 | } |
288 | } |
289 | } |
290 | } |
291 | return $found[0] unless wantarray; |
292 | @found; |
293 | } |
294 | EOS |
2e64bfdb |
295 | } |
296 | |