makerel revision 1.17
1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6# A tool to build a perl release tarball 7# Very basic but functional - if you're on a unix system. 8# 9# If you're on Win32 then it should still work, but various Unix command-line 10# tools will need to be available somewhere. An obvious choice is to install 11# Cygwin and ensure its 'bin' folder is on the PATH in the shell where you run 12# this script. The Cygwin 'bin' folder needs to precede the Windows 'system32' 13# folder so that Cygwin's 'find' command is found in preference to the Windows 14# 'find' command. In addition to the commands installed by default, your Cygwin 15# installation will need to contain at least the 'cpio' and '7z' commands. 16# Finally, ensure that the 'awk' and '7z' commands 17# are copies of 'gawk.exe' and 'lib\p7zip\7z.exe' respectively, 18# rather than the links to them that only work in a Cygwin bash shell which 19# they are by default. 20# 21# No matter how automated this gets, you'll always need to read 22# and re-read pumpkin.pod and release_managers_guide.pod to 23# check for things to be done at various stages of the process. 24# 25# Tim Bunce, June 1997 26 27use ExtUtils::Manifest qw(fullcheck); 28$ExtUtils::Manifest::Quiet = 1; 29use Getopt::Std; 30use Digest::SHA; 31 32$|=1; 33 34sub usage { die <<EOF; } 35usage: $0 [ -r rootdir ] [-s suffix ] [ -x ] [ -n ] 36 -r rootdir directory under which to create the build dir and tarball 37 defaults to '..' 38 -s suffix suffix to append to the perl-x.y.z dir and tarball name 39 defaults to the concatenation of the local_patches entry 40 in patchlevel.h (or blank, if none) 41 -x make a .xz file in addition to a .gz file 42 -n do not make any tarballs, just the directory 43 -c cleanup perform a cleanup before building: clean git repo and target 44 directory/tarballs 45 -e Make the outputs be translated into EBCDIC. (They can then 46 be downloaded directly to an EBCDIC platform without needing 47 any further translation.) 48EOF 49 50my %opts; 51getopts('exncr:s:', \%opts) or usage; 52 53@ARGV && usage; 54 55my $relroot = defined $opts{r} ? $opts{r} : ".."; 56 57die "Must be in root of the perl source tree.\n" 58 unless -f "./MANIFEST" and -f "patchlevel.h"; 59 60open PATCHLEVEL, '<', 'patchlevel.h' or die; 61my @patchlevel_h = <PATCHLEVEL>; 62close PATCHLEVEL; 63my $patchlevel_h = join "", grep { /^#\s*define/ } @patchlevel_h; 64print $patchlevel_h; 65my $revision = $1 if $patchlevel_h =~ /PERL_REVISION\s+(\d+)/; 66my $patchlevel = $1 if $patchlevel_h =~ /PERL_VERSION\s+(\d+)/; 67my $subversion = $1 if $patchlevel_h =~ /PERL_SUBVERSION\s+(\d+)/; 68die "Unable to parse patchlevel.h" unless $subversion >= 0; 69my $vers = sprintf("%d.%d.%d", $revision, $patchlevel, $subversion); 70 71# fetch list of local patches 72my (@local_patches, @lpatch_tags, $lpatch_tags); 73@local_patches = grep { !/^\s*,?NULL/ && ! /,"uncommitted-changes"/ } 74 grep { /^static.*local_patches/../^};/ } 75 @patchlevel_h; 76@lpatch_tags = map { /^\s*,"(\w+)/ } @local_patches; 77$lpatch_tags = join "-", @lpatch_tags; 78 79my $perl = "perl-$vers"; 80my $reldir = "$perl"; 81 82$lpatch_tags = $opts{s} if defined $opts{s}; 83$reldir .= "-$lpatch_tags" if $lpatch_tags; 84 85print "\nMaking a release for $perl in $relroot/$reldir\n\n"; 86 87cleanup($relroot, $reldir) if $opts{c}; 88 89print "Cross-checking the MANIFEST...\n"; 90my ($missfile, $missentry) = fullcheck(); 91@$missentry 92 = grep {$_ !~ m!^\.(?:git|github|mailmap)! and $_ !~ m!(?:/|^)\.gitignore!} @$missentry; 93if (@$missfile ) { 94 warn "Can't make a release with MANIFEST files missing:\n"; 95 warn "\t".$_."\n" for (@$missfile); 96} 97if (@$missentry ) { 98 warn "Can't make a release with files not listed in MANIFEST\n"; 99 warn "\t".$_."\n" for (@$missentry); 100 101} 102if ("@$missentry" =~ m/\.orig\b/) { 103 # Handy listing of find command and .orig files from patching work. 104 # I tend to run 'xargs rm' and copy and paste the file list. 105 my $cmd = "find . -name '*.orig' -print"; 106 print "$cmd\n"; 107 system($cmd); 108} 109die "Aborted.\n" if @$missentry or @$missfile; 110print "\n"; 111 112# VMS no longer has hardcoded version numbers descrip.mms 113 114print "Creating $relroot/$reldir release directory...\n"; 115die "$relroot/$reldir release directory already exists [consider using -c]\n" if -e "$relroot/$reldir"; 116die "$relroot/$reldir.tar.gz release file already exists [consider using -c]\n" if -e "$relroot/$reldir.tar.gz"; 117die "$relroot/$reldir.tar.xz release file already exists [consider using -c]\n" if $opts{x} && -e "$relroot/$reldir.tar.xz"; 118mkdir("$relroot/$reldir", 0755) or die "mkdir $relroot/$reldir: $!\n"; 119print "\n"; 120 121 122print "Copying files to release directory...\n"; 123# ExtUtils::Manifest maniread does not preserve the order 124my $cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $relroot/$reldir"; 125system($cmd) == 0 126 or die "$cmd failed"; 127print "\n"; 128 129chdir "$relroot/$reldir" or die $!; 130 131my @exe = map { my ($f) = split; glob($f) } 132 grep { $_ !~ /\A#/ && $_ !~ /\A\s*\z/ } 133 map { split "\n" } 134 do { local (@ARGV, $/) = 'Porting/exec-bit.txt'; <> }; 135 136if ($opts{e}) { 137 require './regen/charset_translations.pl'; 138 139 # Translation tables, so far only to 1047 140 my @charset = grep { /1047/ } get_supported_code_pages(); 141 142 my $charset = $charset[0]; 143 my $a2e = get_a2n($charset); 144 145 die "$0 must be run on an ASCII platform" if ord("A") != 65; 146 147 print "Translating to EBCDIC...\n"; 148 149 open my $mani_fh, "<", "MANIFEST" or die "Can't read copied MANIFEST: $!"; 150 my @manifest = <$mani_fh>; # Slurp in whole thing before the file gets trashed 151 close $mani_fh or die "Couldn't close MANIFEST: $!"; 152 while (defined ($_ = shift @manifest)) { 153 chomp; 154 my $file = $_ =~ s/\s.*//r; # Rmv description to get just the file 155 # name 156 157 local $/; # slurp mode 158 open my $fh, "+<:raw", $file or die "Can't read copied $file: $!"; 159 my $text = <$fh>; 160 my $xlated = ""; 161 my $utf16_high = 0; 162 my $utf16_low = 0; 163 164 my $potential_BOM = substr($text, 0, 2); 165 if ($potential_BOM eq "\xFE\xFF") { 166 $utf16_high = 0; 167 $utf16_low = 1; 168 print STDERR "$file is UTF-16BE\n"; 169 } 170 elsif ($potential_BOM eq "\xFF\xFE") { 171 $utf16_high = 1; 172 $utf16_low = 0; 173 print STDERR "$file is UTF-16LE\n"; 174 } 175 176 if ($utf16_high || $utf16_low) { 177 my $len = length $text; 178 die "Odd length in UTF-16 files: $file" if $len % 2; 179 180 # Look 2 bytes at a time 181 for (my $i = 0; $i < $len; $i+=2) { 182 my $cur = substr($text, $i, 2); 183 184 # If the code point's high byte is 0, it means the code point 185 # itself is 00-FF, so want native value of it. 186 if (substr($cur, $utf16_high, 1) eq "\0") { 187 188 # Just substitute the translated native value 189 my $low_byte = substr($cur, $utf16_low, 1); 190 $low_byte = chr $a2e->[ord $low_byte]; 191 substr($cur, $utf16_low, 1) = $low_byte; 192 } 193 194 $xlated .= $cur; 195 } 196 } 197 elsif (-B $file) { # Binary files aren't translated 198 print STDERR "$file is binary\n"; 199 close $fh or die "Couldn't close $file: $!"; 200 next; 201 } 202 else { 203 if ( ! utf8::decode($text) 204 || $text =~ / ^ [[:ascii:][:cntrl:]]* $ /x) 205 { 206 # Here, either $text isn't legal UTF-8; or it is, but it 207 # consists entirely of one of the 160 ASCII and control 208 # characters whose EBCDIC representation is the same whether 209 # UTF-EBCDIC or not. This means we just translate 210 # byte-by-byte from Latin1 to EBCDIC. 211 $xlated = ($text =~ s/(.)/chr $a2e->[ord $1]/rsge); 212 } 213 else { 214 215 # Here, $text is legal UTF-8, and the representation of some 216 # character(s) in it it matters if is encoded in UTF-EBCDIC or 217 # not. Also, the decode caused $text to now be viewed as 218 # UTF-8 characters instead of the input bytes. We convert to 219 # UTF-EBCDIC. 220 $xlated = ($text =~ s/(.)/cp_2_utfbytes(ord $1, $charset)/rsge); 221 } 222 } 223 224 # Overwrite the file with the translation 225 truncate $fh, 0; 226 seek $fh, 0, 0; 227 print $fh $xlated; 228 229 close $fh or die "Couldn't close $file: $!"; 230 } 231} 232 233print "Setting file permissions...\n"; 234system("find . -type f -print | xargs chmod 0444"); 235system("find . -type d -print | xargs chmod 0755"); 236 237system("chmod +x @exe") == 0 238 or die "system: $!"; 239 240# MANIFEST may be resorted, so needs to be writable 241my @writables = qw( 242 feature.h 243 lib/feature.pm 244 keywords.h 245 keywords.c 246 MANIFEST 247 opcode.h 248 opnames.h 249 pp_proto.h 250 proto.h 251 embed.h 252 embedvar.h 253 overload.inc 254 overload.h 255 mg_vtable.h 256 dist/Devel-PPPort/module2.c 257 dist/Devel-PPPort/module3.c 258 cpan/autodie/t/touch_me 259 reentr.c 260 reentr.h 261 regcharclass.h 262 regnodes.h 263 warnings.h 264 lib/warnings.pm 265 win32/GNUmakefile 266 win32/Makefile 267 win32/config_H.gc 268 win32/config_H.vc 269 uconfig.h 270); 271 272my $out = `chmod u+w @writables 2>&1`; 273if ($? != 0) { 274 warn $out; 275 if ($out =~ /no such file/i) { 276 warn "Check that the files above still exist in the Perl core.\n"; 277 warn "If not, remove them from \@writables in Porting/makerel\n"; 278 } 279 exit 1; 280} 281 282warn $out if $out; 283 284chdir ".." or die $!; 285 286exit if $opts{n}; 287 288my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch 289 290my $output_7z; 291my $have_7z; 292if (! $opts{e}) { 293 print "Checking if you have 7z...\n"; 294 $output_7z = `7z 2>&1`; 295 $have_7z = defined $output_7z && $output_7z =~ /7-Zip/; 296} 297 298print "Checking if you have advdef...\n"; 299my $output_advdef = `advdef --version 2>&1`; 300my $have_advdef = defined $output_advdef && $output_advdef =~ /advancecomp/; 301 302if (! $opts{e} && $have_7z) { 303 print "Creating and compressing the tar.gz file with 7z...\n"; 304 $cmd = "tar cf - $reldir | 7z a -tgzip -mx9 -bd -si $reldir.tar.gz"; 305 system($cmd) == 0 or die "$cmd failed"; 306} else { 307 print "Creating and compressing the tar.gz file...\n"; 308 my $extra_opts = ""; 309 if ($opts{e}) { 310 print "(Using ustar format since is for an EBCDIC box)\n"; 311 $extra_opts = ' --format=ustar'; 312 } 313 $cmd = "tar cf - $extra_opts $reldir | gzip --best > $reldir.tar.gz"; 314 system($cmd) == 0 or die "$cmd failed"; 315 if ($have_advdef) { 316 print "Recompressing the tar.gz file with advdef...\n"; 317 $cmd = "advdef -z -4 $reldir.tar.gz"; 318 system($cmd) == 0 or die "$cmd failed"; 319 } 320} 321 322if ($opts{x}) { 323 print "Creating and compressing the tar.xz file with xz...\n"; 324 $cmd = "tar cf - $reldir | xz -z -c > $reldir.tar.xz"; 325 system($cmd) == 0 or die "$cmd failed"; 326} 327 328print "\n"; 329 330system("ls -ld $perl*"); 331print "\n"; 332 333my @files = glob "'$perl*.tar.*'"; 334for my $file (@files) { 335 my $sha = Digest::SHA->new('sha256'); 336 $sha->addfile($file, 'b'); 337 print $sha->hexdigest . " $file\n"; 338} 339 340sub cleanup { 341 my ( $relroot, $reldir ) = @_; 342 343 require File::Path; 344 345 my @cmds = ( 346 [ qw{make distclean} ], 347 [ qw{git clean -dxf} ], 348 ); 349 350 foreach my $cmd (@cmds) { 351 print join( ' ', "Running:", @$cmd, "\n" ); 352 system @$cmd; 353 die "fail to run ".(join(' ', @$cmd) ) unless $? == 0; 354 } 355 356 if ( -d "$relroot/$reldir" ) { 357 print "Removing directory $relroot/$reldir\n"; 358 File::Path::rmtree("$relroot/$reldir"); 359 } 360 361 # always clean both 362 my @files = ( "$relroot/$reldir.tar.gz", "$relroot/$reldir.tar.xz" ); 363 364 foreach my $f ( @files ) { 365 next unless -f $f; 366 print "Removing file '$f'\n"; 367 unlink($f); 368 } 369 370 return; 371 372} 373 3741; 375