Skip to content

Commit 2500136

Browse files
shawnlaffanshawnlaffan
authored
Merge pull request #115 from StrawberryPerl/wip_536
Changes for 5.36 and 5.38
2 parents 4331b33 + d8add25 commit 2500136

18 files changed

+4925
-11
lines changed

‎Build.PL

+1-1
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ my $builder = $class->new(
3030
'Module::Build' => '0.38',
3131
},
3232
requires => {
33-
'perl' => '5.012',
33+
'perl' => '5.014',
3434
'Module::Build' => '0.38',
3535
},
3636
build_requires => {

‎devel.utils/_build-5.36.bat

+20
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
::@cls
2+
::call ..\build.bat test
3+
4+
::set PERL_USE_UNSAFE_INC=1
5+
6+
set SP=z:\sp532
7+
set PATH=Z:\mingw64\bin;%SP%\c\bin;%SP%\perl\bin;%SP%\perl\site\bin;%PATH%
8+
set PERLEXE=%SP%\perl\bin\perl
9+
10+
:: update blib - requires Build.PL to have been run
11+
set OLD_CD=%cd%
12+
cd ..
13+
call Build
14+
cd %OLD_CD%
15+
16+
set SKIP_MSI_STEP=1
17+
set SKIP_PDL_STEP=1
18+
%PERLEXE% -Mblib ..\script\perldist_strawberry -job ..\share\64bit-5.36.1.1.pp -notest_core -beta=0 -nointeractive -norestorepoints -wixbin_dir=z:\sw\wix311 -cpan_url https://cpan.metacpan.org
19+
20+

‎devel.utils/_build-5.38.bat

+24
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
::@cls
2+
::call ..\build.bat test
3+
4+
::set PERL_USE_UNSAFE_INC=1
5+
6+
set SP=z:\sp532
7+
set PATH=Z:\mingw64\bin;%SP%\c\bin;%SP%\perl\bin;%SP%\perl\site\bin;%PATH%
8+
set PERLEXE=%SP%\perl\bin\perl
9+
10+
:: update blib - requires Build.PL to have been run
11+
set OLD_CD=%cd%
12+
cd ..
13+
call Build
14+
cd %OLD_CD%
15+
16+
set MAKEFLAGS=-j8
17+
set TEST_JOBS=8
18+
set LC_ALL=C
19+
20+
::set SKIP_MSI_STEP=1
21+
::set SKIP_PDL_STEP=1
22+
%PERLEXE% -Mblib ..\script\perldist_strawberry -job ..\share\64bit-5.38.0.1.pp -notest_core -beta=0 -interactive -restorepoints -wixbin_dir=z:\sw\wix311 -cpan_url https://cpan.metacpan.org
23+
24+

‎lib/Perl/Dist/Strawberry.pm

+7-2
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
package Perl::Dist::Strawberry;
22

3-
use 5.012;
3+
use 5.014;
44
use warnings;
55

66
use Data::Dump qw(pp);
@@ -422,6 +422,10 @@ sub message {
422422

423423
sub resolve_name {
424424
my ($self, $name, $skip_canon) = @_;
425+
426+
# don't change references
427+
return $name if ref ($name);
428+
425429
if ($name =~ /<(package_url|dist_sharedir|image_dir)>/) {
426430
my $r = $self->global->{$1};
427431
$name =~ s/<(package_url|dist_sharedir|image_dir)>/$r/g if defined $r;
@@ -485,7 +489,8 @@ sub zip_dir {
485489
$level //= 1;
486490
$self->message(3, "started: zip_dir('$dir', '$zip_filename', $level)\n");
487491
die "ERROR: non-existing dir '$dir'" unless -d $dir;
488-
my @items = File::Find::Rule->in($dir);
492+
$dir =~ s{\\}{/}g; # normalise paths
493+
my @items = map {s{\\}{/}gr} File::Find::Rule->in($dir);
489494
my $zip = Archive::Zip->new();
490495
for my $fs_name (@items) {
491496
(my $archive_name = $fs_name) =~ s|^\Q$dir\E[/\\]*||i;

‎lib/Perl/Dist/Strawberry/Step.pm

+192-3
Original file line numberDiff line numberDiff line change
@@ -288,8 +288,20 @@ sub backup_file {
288288

289289
sub _patch_file {
290290
my ($self, $new, $dst, $dir, $tt_vars, $no_backup) = @_;
291+
$self->boss->message(5, "PATCHING '$new' '$dst' '$dir' $tt_vars " . ($no_backup||'') . "\n");
291292

292-
if (!-f $new) {
293+
if ($dst =~ /\*$/) {
294+
warn "WE IS PATCHIN '$new'";
295+
}
296+
if ($new eq 'config_H.gc' and ref($dst) =~ /HASH/) {
297+
$self->boss->message(5, "_patch_file: using hash of values to update config_H.gc'\n");
298+
$self->_update_config_H_gc ("$dir/win32/config_H.gc", $dst);
299+
}
300+
elsif ($new eq 'config.gc' and ref($dst) =~ /HASH/) {
301+
$self->boss->message(5, "_patch_file: using hash of values to update config.gc'\n");
302+
$self->_update_config_gc ("$dir/win32/config.gc", $dst);
303+
}
304+
elsif (!-f $new) {
293305
warn "ERROR: non-existing file '$new'";
294306
}
295307
elsif ($new =~ /\.tt$/) {
@@ -427,6 +439,8 @@ sub _install_module {
427439
my $env = {
428440
PERL_MM_USE_DEFAULT=>1, AUTOMATED_TESTING=>undef, RELEASE_TESTING=>undef,
429441
PERL5_CPANPLUS_HOME=>$self->global->{build_ENV}->{APPDATA}, #workaround for CPANPLUS
442+
PERL_CPANM_HOME => ($self->global->{build_ENV}->{APPDATA} . '/.cpanm'), # GH#101
443+
PKG_CONFIG_PATH => ($self->global->{image_dir} . '/c/lib/pkgconf'), # just to be sure
430444
};
431445
# resolve macros in env{}
432446
if (defined $args{env} && ref $args{env} eq 'HASH') {
@@ -462,7 +476,7 @@ sub _install_module {
462476
# Execute the module install script
463477
my $rv = $self->execute_special(['perl', $script_pl, %params], $log, $log, $env);
464478
unless(defined $rv && $rv == 0) {
465-
rename $log, catfile($self->global->{debug_dir}, "mod_install_FAIL_".$now."_".$shortname.".log.txt");
479+
rename $log, catfile($self->global->{debug_dir}, "mod_install_${shortname}_FAIL_${now}.log.txt");
466480
return [], $rv;
467481
}
468482
my $data = retrieve($nstore_file) or die "ERROR: retrieve failed";
@@ -515,4 +529,179 @@ sub _apply_patch {
515529
}
516530
}
517531

518-
1;
532+
sub _update_config_H_gc {
533+
my ($self, $fname, $update_hash) = @_;
534+
535+
die "update hash arg is not a hash ref"
536+
if not ref($update_hash) =~ /HASH/;
537+
538+
open my $fh, $fname or die "Unable to open $fname, $!";
539+
540+
my $output;
541+
while (defined (my $line = <$fh>)) {
542+
$line =~ s/[\r\n]+$//;
543+
if ($line =~ /#define\s+(\w+)/ and exists $update_hash->{$1}) {
544+
my $key = $1;
545+
$line
546+
= !defined $update_hash->{$key} ? "/*#define $key\t\t/ **/"
547+
: $update_hash->{$key} eq 'define' ? "#define $key\t\t/* */"
548+
: "$update_hash->{$key}";
549+
}
550+
$output .= "$line\n";
551+
}
552+
553+
$fh->close;
554+
555+
556+
# long name but otherwise we interfere with patch backups
557+
rename $fname, "$fname.orig.before_hash_update" or die $!;
558+
open my $ofh, '>', $fname or die "Unable to open $fname to write to, $!";
559+
print {$ofh} $output;
560+
$ofh->close;
561+
562+
}
563+
564+
sub _update_config_gc {
565+
my ($self, $fname, $update_hash) = @_;
566+
567+
die "update hash arg is not a hash ref"
568+
if not ref($update_hash) =~ /HASH/;
569+
570+
open my $fh, $fname or die "Unable to open $fname, $!";
571+
572+
my @lines = (<$fh>);
573+
close $fh;
574+
575+
my %data;
576+
my @output;
577+
my @perl_lines; # lines starting with PERL
578+
579+
while (defined(my $line = shift @lines)) {
580+
$line =~ s/[\r\n]+$//;
581+
if ($line =~ /^#/) {
582+
# headers stay as they are
583+
push @output, $line;
584+
}
585+
elsif ($line =~ /^PERL/) {
586+
push @perl_lines, $line;
587+
}
588+
else {
589+
$line =~ m/^([\w]+)=(.+)$/;
590+
$data{$1} = $2;
591+
}
592+
}
593+
594+
my $default_config_hash = $self->_get_default_config_hash;
595+
@data{keys %$default_config_hash} = values %$default_config_hash;
596+
597+
# fix up quoting of values
598+
foreach my $val (values %$update_hash) {
599+
next if $val =~ /^'/; # assumes symmetry, i.e. opening and closing
600+
$val = "'$val'";
601+
}
602+
603+
@data{keys %$update_hash} = values %$update_hash;
604+
#foreach my $key (sort keys %$update_hash) {
605+
#
606+
#$self->boss->message(3, "Setting config, $key => $update_hash->{$key}");
607+
#$data{$key} = $update_hash->{$key};
608+
#}
609+
610+
my (@ucfirst_lines, @lcfirst_lines);
611+
foreach my $key (grep {/^[A-Z]/} keys %data) {
612+
push @ucfirst_lines, "$key=$data{$key}";
613+
}
614+
foreach my $key (grep {/^[_a-z]/} keys %data) {
615+
push @lcfirst_lines, "$key=$data{$key}";
616+
}
617+
push @output, (sort @ucfirst_lines), (sort @lcfirst_lines), @perl_lines;
618+
619+
# long name but otherwise we interfere with patch backups
620+
rename $fname, "$fname.orig.before_hash_update" or die $!;
621+
open my $ofh, '>', $fname or die "Unable to open $fname to write to, $!";
622+
say {$ofh} join "\n", @output;
623+
$ofh->close;
624+
625+
}
626+
627+
sub _get_default_config_hash {
628+
my $self = shift;
629+
630+
my $h = {
631+
archlib => '~INST_TOP~\lib',
632+
archlibexp => '~INST_TOP~\lib',
633+
bin => '~INST_TOP~\bin',
634+
binexp => '~INST_TOP~\bin',
635+
d_vendorarch => 'define',
636+
d_vendorbin => 'define',
637+
d_vendorlib => 'define',
638+
d_vendorscript => 'define',
639+
dlext => 'xs.dll',
640+
installarchlib => '~INST_TOP~\lib',
641+
installbin => '~INST_TOP~\bin',
642+
installhtmldir => '',
643+
installhtmlhelpdir => '',
644+
installman1dir => '',
645+
installman3dir => '',
646+
installprefix => '~INST_TOP~',
647+
installprefixexp => '~INST_TOP~',
648+
installprivlib => '~INST_TOP~\lib',
649+
installscript => '~INST_TOP~\bin',
650+
installsitearch => '~INST_TOP~\site\lib',
651+
installsitebin => '~INST_TOP~\site\bin',
652+
installsitelib => '~INST_TOP~\site\lib',
653+
installsitescript => '~INST_TOP~\site\bin',
654+
installvendorarch => '~INST_TOP~\vendor\lib',
655+
installvendorbin => '~INST_TOP~\bin',
656+
installvendorlib => '~INST_TOP~\vendor\lib',
657+
installvendorscript => '~INST_TOP~\bin',
658+
man1dir => '',
659+
man1direxp => '',
660+
man3dir => '',
661+
man3direxp => '',
662+
perlpath => '~INST_TOP~\bin\perl.exe',
663+
privlib => '~INST_TOP~\lib',
664+
privlibexp => '~INST_TOP~\lib',
665+
scriptdir => '~INST_TOP~\bin',
666+
scriptdirexp => '~INST_TOP~\bin',
667+
sitearch => '~INST_TOP~\site\lib',
668+
sitearchexp => '~INST_TOP~\site\lib',
669+
sitebin => '~INST_TOP~\site\bin',
670+
sitebinexp => '~INST_TOP~\site\bin',
671+
sitelib => '~INST_TOP~\site\lib',
672+
sitelibexp => '~INST_TOP~\site\lib',
673+
siteprefix => '~INST_TOP~\site',
674+
siteprefixexp => '~INST_TOP~\site',
675+
sitescript => '~INST_TOP~\site\bin',
676+
sitescriptexp => '~INST_TOP~\site\bin',
677+
usevendorprefix => 'define',
678+
usrinc => 'C:\strawberry\c\include',
679+
vendorarch => '~INST_TOP~\vendor\lib',
680+
vendorarchexp => '~INST_TOP~\vendor\lib',
681+
vendorbin => '~INST_TOP~\bin',
682+
vendorbinexp => '~INST_TOP~\bin',
683+
vendorlib => '~INST_TOP~\vendor\lib',
684+
vendorlibexp => '~INST_TOP~\vendor\lib',
685+
vendorprefix => '~INST_TOP~\vendor',
686+
vendorprefixexp => '~INST_TOP~\vendor',
687+
vendorscript => '~INST_TOP~\bin',
688+
vendorscriptexp => '~INST_TOP~\bin',
689+
};
690+
691+
use POSIX qw(strftime);
692+
my $time = strftime '%H:%M:%S %a %B %d %Y', gmtime();
693+
my $bits = $self->global->{bits};
694+
my $app_version = $self->global->{app_version};
695+
$h->{myuname} = "Win32 strawberry-perl $app_version # $time x${bits}";
696+
697+
# fix up quoting of values - saves a heap of editing
698+
foreach my $val (values %$h) {
699+
next if $val =~ /^'/; # assumes symmetry, i.e. opening and closing
700+
$val = "'$val'";
701+
}
702+
703+
return $h;
704+
}
705+
706+
1;
707+

‎lib/Perl/Dist/Strawberry/Step/BinaryToolsAndLibs.pm

+2-2
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ sub run {
4545

4646
my $files;
4747
my $pkgs = $self->{config}->{install_packages};
48-
for my $p (keys %$pkgs) {
48+
for my $p ( sort keys %$pkgs) {
4949
$files = $self->_install($p, $pkgs->{$p});
5050
$self->boss->message(5, "pkg='$p'");
5151
}
@@ -114,4 +114,4 @@ sub _filters {
114114
];
115115
}
116116

117-
1;
117+
1;

‎lib/Perl/Dist/Strawberry/Step/FilesAndDirs.pm

+6-1
Original file line numberDiff line numberDiff line change
@@ -171,6 +171,11 @@ sub _do_job {
171171
$self->boss->message(4, "gonna smartmove '$src' >> '$dst'");
172172
File::Copy::Recursive::rmove_glob($src, $dst) or warn "rmove_glob failed [$src]>[$dst]: $!"; #just warn when wildcard has no match
173173
}
174+
elsif ($cmd eq 'make_rw') {
175+
my ($src) = ($self->boss->resolve_name($args->[0]));
176+
$self->boss->message(4, "gonna make '$src' read-write");
177+
$self->_unset_ro($src);
178+
}
174179
else {
175180
#XXX-TODO
176181
die "FATAL: '$cmd' not implemented";
@@ -189,4 +194,4 @@ sub _check_valid_prefix {
189194
#XXX-TODO implement or remove
190195
}
191196

192-
1;
197+
1;

‎lib/Perl/Dist/Strawberry/Step/InstallPerlCore.pm

+6-2
Original file line numberDiff line numberDiff line change
@@ -78,7 +78,9 @@ sub run {
7878
my $patch = $self->{config}->{patch};
7979
if ($patch) {
8080
while (my ($new, $dst) = each %$patch) {
81-
$self->_patch_file($self->boss->resolve_name($new), catfile($unpack_to, $perlsrc, $dst), catdir($unpack_to, $perlsrc), $tt_vars);
81+
# double pack refs, or update the names
82+
$dst = ref ($dst) ? $dst : catfile($unpack_to, $perlsrc, $dst);
83+
$self->_patch_file($self->boss->resolve_name($new), $dst, catdir($unpack_to, $perlsrc), $tt_vars);
8284
}
8385
}
8486

@@ -236,6 +238,8 @@ sub run {
236238
copy($from, catfile($image_dir, qw/perl bin libstdc++-6.dll/)) if -f $from;
237239
$from = catfile($image_dir, qw/c bin libwinpthread-1.dll/);
238240
copy($from, catfile($image_dir, qw/perl bin libwinpthread-1.dll/)) if -f $from;
241+
$from = catfile($image_dir, qw/c bin libmcfgthread-1.dll/);
242+
copy($from, catfile($image_dir, qw/perl bin libmcfgthread-1.dll/)) if -f $from;
239243

240244
# Delete a2p.exe (Can't relocate a binary).
241245
my $a = catfile($image_dir, 'perl', 'bin', 'a2p.exe');
@@ -293,4 +297,4 @@ sub _strip_debug {
293297
}
294298
}
295299

296-
1;
300+
1;

0 commit comments

Comments
 (0)