wince/makedist.pl

   1 use strict;
   2 use Cwd;
   3 use File::Path;
   4 use File::Find;
   5
   6 my %opts = (
   7   #defaults
   8     'verbose' => 1, # verbose level, in range from 0 to 2
   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 :)
  15     'cross-name' => 'wince',
  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
  19     'zip' => 0,     # perform zip
  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
  26 # TODO
  27 #   -- error checking. When something goes wrong, just exit with rc!=0
  28 #   -- may be '--zip' option should be made differently?
  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
  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
  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
  69 if ($opts{'verbose'} >=1) {
  70   print STDERR "Copying perl lib files...\n";
  71 }
  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;
  89 if ($opts{'verbose'} >=1) {
  90   print STDERR "Copying perl core extensions...\n";
  91 }
  92 for (@efiles) {
  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;
 107 }
 108
 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";
 116 # how do we know exact name of perl.dll?
 117
 118 # auto
 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
 123 my @afiles;
 124 chdir "../xlib/$opts{'cross-name'}/auto";
 125 find({no_chdir=>1,wanted=>sub{push @afiles, $_ if /\.(dll|bs)$/}},'.');
 126 chdir $cwd;
 127 if ($opts{'verbose'} >=1) {
 128   print STDERR "Copying binaries for perl core extensions...\n";
 129 }
 130 for (@afiles) {
 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   }
 137 }
 138
 139 sub copy($$) {
 140   my ($fnfrom, $fnto) = @_;
 141   open my $fh, "<$fnfrom" or die "can not open $fnfrom: $!";
 142   binmode $fh;
 143   local $/;
 144   my $ffrom = <$fh>;
 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;
 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     }
 154   }
 155   mkpath $1 if $fnto=~/^(.*)\/([^\/]+)$/;
 156   open my $fhout, ">$fnto";
 157   binmode $fhout;
 158   print $fhout $ffrom;
 159   if ($opts{'verbose'} >=2) {
 160     print STDERR "copying $fnfrom=>$fnto\n";
 161   }
 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
 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);
 217
 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
 295 }
 296