[perl5.git] / wince / makedist.pl

use strict;
use Cwd;
use File::Path;
use File::Find;

my %opts = (
  #defaults
    'verbose' => 1, # verbose level, in range from 0 to 2
    'distdir' => 'distdir',
    'unicode' => 1, # include unicode by default
    'minimal' => 0, # minimal possible distribution.
                    # actually this is just perl.exe and perlXX.dll
		    # but can be extended by additional exts 
		    #  ... (as soon as this will be implemented :)
    'cross-name' => 'wince',
    'strip-pod' => 0, # strip POD from perl modules
    'adaptation' => 1, # do some adaptation, such as stripping such
                       # occurences as "if ($^O eq 'VMS'){...}" for Dynaloader.pm
    'zip' => 0,     # perform zip
    'clean-exts' => 0,
  #options itself
    (map {/^--([\-_\w]+)=(.*)$/} @ARGV),                            # --opt=smth
    (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),  # --opt --no-opt --noopt
  );

# TODO
#   -- error checking. When something goes wrong, just exit with rc!=0
#   -- may be '--zip' option should be made differently?

my $cwd = cwd;

if ($opts{'clean-exts'}) {
  # unfortunately, unlike perl58.dll and like, extensions for different
  # platforms are built in same directory, therefore we must be able to clean
  # them often
  unlink '../config.sh'; # delete cache config file, which remembers our previous config
  chdir '../ext';
  find({no_chdir=>1,wanted => sub{
        unlink if /((?:\.obj|\/makefile|\/errno\.pm))$/i;
      }
    },'.');
  exit;
}

# zip
if ($opts{'zip'}) {
  if ($opts{'verbose'} >=1) {
    print STDERR "zipping...\n";
  }
  chdir $opts{'distdir'};
  unlink <*.zip>;
  `zip -R perl-$opts{'cross-name'} *`;
  exit;
}

my (%libexclusions, %extexclusions);
my @lfiles;
sub copy($$);

# lib
chdir '../lib';
find({no_chdir=>1,wanted=>sub{push @lfiles, $_ if /\.p[lm]$/}},'.');
chdir $cwd;
# exclusions
@lfiles = grep {!exists $libexclusions{$_}} @lfiles;
#inclusions
#...
#copy them
if ($opts{'verbose'} >=1) {
  print STDERR "Copying perl lib files...\n";
}
for (@lfiles) {
  /^(.*)\/[^\/]+$/;
  mkpath "$opts{distdir}/lib/$1";
  copy "../lib/$_", "$opts{distdir}/lib/$_";
}

#ext
my @efiles;
chdir '../ext';
find({no_chdir=>1,wanted=>sub{push @efiles, $_ if /\.pm$/}},'.');
chdir $cwd;
# exclusions
#...
#inclusions
#...
#copy them
#{s[/(\w+)/\1\.pm][/$1.pm]} @efiles;
if ($opts{'verbose'} >=1) {
  print STDERR "Copying perl core extensions...\n";
}
for (@efiles) {
  if (m#^.*?/lib/(.*)$#) {
    copy "../ext/$_", "$opts{distdir}/lib/$1";
  }
  else {
    /^(.*)\/([^\/]+)\/([^\/]+)$/;
    copy "../ext/$_", "$opts{distdir}/lib/$1/$3";
  }
}
my ($dynaloader_pm);
if ($opts{adaptation}) {
  # let's copy our Dynaloader.pm (make this optional?)
  open my $fhdyna, ">$opts{distdir}/lib/Dynaloader.pm";
  print $fhdyna $dynaloader_pm;
  close $fhdyna;
}

# Config.pm, perl binaries
if ($opts{'verbose'} >=1) {
  print STDERR "Copying Config.pm, perl.dll and perl.exe...\n";
}
copy "../xlib/$opts{'cross-name'}/Config.pm", "$opts{distdir}/lib/Config.pm";
copy "$opts{'cross-name'}/perl.exe", "$opts{distdir}/bin/perl.exe";
copy "$opts{'cross-name'}/perl.dll", "$opts{distdir}/bin/perl.dll";
# how do we know exact name of perl.dll?

# auto
my %aexcl = (socket=>'Socket_1');
# Socket.dll and may be some other conflict with same file in \windows dir
# on WinCE, %aexcl needed to replace it with a different name that however
# will be found by Dynaloader
my @afiles;
chdir "../xlib/$opts{'cross-name'}/auto";
find({no_chdir=>1,wanted=>sub{push @afiles, $_ if /\.(dll|bs)$/}},'.');
chdir $cwd;
if ($opts{'verbose'} >=1) {
  print STDERR "Copying binaries for perl core extensions...\n";
}
for (@afiles) {
  if (/^(.*)\/(\w+)\.dll$/i && exists $aexcl{lc($2)}) {
    copy "../xlib/$opts{'cross-name'}/auto/$_", "$opts{distdir}/lib/auto/$1/$aexcl{lc($2)}.dll";
  }
  else {
    copy "../xlib/$opts{'cross-name'}/auto/$_", "$opts{distdir}/lib/auto/$_";
  }
}

sub copy($$) {
  my ($fnfrom, $fnto) = @_;
  open my $fh, "<$fnfrom" or die "can not open $fnfrom: $!";
  binmode $fh;
  local $/;
  my $ffrom = <$fh>;
  if ($opts{'strip-pod'}) {
    # actually following regexp is suspicious to not work everywhere.
    # but we've checked on our set of modules, and it's fit for our purposes
    $ffrom =~ s/^=\w+.*?^=cut(?:\n|\Z)//msg;
    unless ($ffrom=~/\bAutoLoader\b/) {
      # this logic actually strip less than could be stripped, but we're
      # not risky. Just strip only of no mention of AutoLoader
      $ffrom =~ s/^__END__.*\Z//msg;
    }
  }
  mkpath $1 if $fnto=~/^(.*)\/([^\/]+)$/;
  open my $fhout, ">$fnto";
  binmode $fhout;
  print $fhout $ffrom;
  if ($opts{'verbose'} >=2) {
    print STDERR "copying $fnfrom=>$fnto\n";
  }
}

BEGIN {
%libexclusions = map {$_=>1} split/\s/, <<"EOS";
abbrev.pl bigfloat.pl bigint.pl bigrat.pl cacheout.pl complete.pl ctime.pl
dotsh.pl exceptions.pl fastcwd.pl flush.pl ftp.pl getcwd.pl getopt.pl
getopts.pl hostname.pl look.pl newgetopt.pl pwd.pl termcap.pl
EOS
%extexclusions = map {$_=>1} split/\s/, <<"EOS";
EOS
$dynaloader_pm=<<'EOS';
# This module designed *only* for WinCE
# if you encounter a problem with this file, try using original Dynaloader.pm
# from perl distribution, it's larger but essentially the same.
package DynaLoader;
our $VERSION = 1.04;

$dl_debug ||= 0;

@dl_require_symbols = ();       # names of symbols we need

#@dl_librefs = (); # things we have loaded
#@dl_modules = (); # Modules we have loaded

boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && !defined(&dl_error);

print STDERR "DynaLoader not linked into this perl\n"
  unless defined(&boot_DynaLoader);

1; # End of main code

sub croak{require Carp;Carp::croak(@_)}
sub bootstrap_inherit {
    my $module = $_[0];
    local *isa = *{"$module\::ISA"};
    local @isa = (@isa, 'DynaLoader');
    bootstrap(@_);
}
sub bootstrap {
    # use local vars to enable $module.bs script to edit values
    local(@args) = @_;
    local($module) = $args[0];
    local(@dirs, $file);

    unless ($module) {
	require Carp;
	Carp::confess("Usage: DynaLoader::bootstrap(module)");
    }

    croak("Can't load module $module, dynamic loading not available in this perl.\n")
	unless defined(&dl_load_file);

    my @modparts = split(/::/,$module);
    my $modfname = $modparts[-1];
    my $modpname = join('/',@modparts);

    for (@INC) {
	my $dir = "$_/auto/$modpname";
	next unless -d $dir;
	my $try = "$dir/$modfname.dll";
	last if $file = ( (-f $try) && $try);
	
	$try = "$dir/${modfname}_1.dll";
	last if $file = ( (-f $try) && $try);
	push @dirs, $dir;
    }
    $file = dl_findfile(map("-L$_",@dirs,@INC), $modfname) unless $file;

    croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)")
	unless $file;

    (my $bootname = "boot_$module") =~ s/\W/_/g;
    @dl_require_symbols = ($bootname);

    # optional '.bootstrap' perl script
    my $bs = $file;
    $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/;
    if (-s $bs) { # only read file if it's not empty
        eval { do $bs; };
        warn "$bs: $@\n" if $@;
    }

    my $libref = dl_load_file($file, 0) or
	croak("Can't load '$file' for module $module: ".dl_error());

    push(@dl_librefs,$libref);  # record loaded object

    my @unresolved = dl_undef_symbols();
    if (@unresolved) {
	require Carp;
	Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
    }

    my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
         croak("Can't find '$bootname' symbol in $file\n");

    push(@dl_modules, $module);

  boot:
    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
    &$xs(@args);
}

sub dl_findfile {
    my (@args) = @_;
    my (@dirs,  $dir);
    my (@found);

    arg: foreach(@args) {
        if (m:/: && -f $_) {
	    push(@found,$_);
	    last arg unless wantarray;
	    next;
	}

        if (s:^-L::) {push(@dirs, $_); next;}
        if (m:/: && -d $_) {push(@dirs, $_); next;}

        for $dir (@dirs) {
            next unless -d $dir;
            for my $name (/\.dll$/i?($_):("$_.dll",$_)) {
                print STDERR " checking in $dir for $name\n" if $dl_debug;
        	if (-f "$dir/$name") {
                    push(@found, "$dir/$name");
                    next arg;
                }
            }
        }
    }
    return $found[0] unless wantarray;
    @found;
}
EOS
}
Commit	Line	Data
2e64bfdb JH	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 JH	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 VK	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 JH	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 JH	26	# TODO
	27	# -- error checking. When something goes wrong, just exit with rc!=0
	28	# -- may be '--zip' option should be made differently?
2e64bfdb JH	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 JH	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 JH	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 JH	69	if ($opts{'verbose'} >=1) {
	70	print STDERR "Copying perl lib files...\n";
	71	}
2e64bfdb JH	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 JH	89	if ($opts{'verbose'} >=1) {
	90	print STDERR "Copying perl core extensions...\n";
	91	}
2e64bfdb	92	for (@efiles) {
1fa63a09 VK	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 JH	107	}
2e64bfdb JH	108
c96f74ce JH	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 JH	117
2e64bfdb JH	118	# auto
1fa63a09 VK	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 JH	125	find({no_chdir=>1,wanted=>sub{push @afiles, $_ if /\.(dll\|bs)$/}},'.');
2e64bfdb JH	126	chdir $cwd;
c96f74ce JH	127	if ($opts{'verbose'} >=1) {
	128	print STDERR "Copying binaries for perl core extensions...\n";
	129	}
2e64bfdb	130	for (@afiles) {
1fa63a09 VK	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 JH	137	}
2e64bfdb JH	138
c96f74ce	139	sub copy($$) {
2e64bfdb	140	my ($fnfrom, $fnto) = @_;
c96f74ce JH	141	open my $fh, "<$fnfrom" or die "can not open $fnfrom: $!";
	142	binmode $fh;
	143	local $/;
	144	my $ffrom = <$fh>;
2e64bfdb JH	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 VK	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 JH	154	}
	155	mkpath $1 if $fnto=~/^(.*)\/([^\/]+)$/;
	156	open my $fhout, ">$fnto";
c96f74ce	157	binmode $fhout;
2e64bfdb	158	print $fhout $ffrom;
c96f74ce JH	159	if ($opts{'verbose'} >=2) {
	160	print STDERR "copying $fnfrom=>$fnto\n";
	161	}
2e64bfdb JH	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 VK	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 VK	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 JH	295	}
2e64bfdb JH	296