makerel revision 1.18
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(manicheck); 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 = manicheck(); 91if (@missfile) { 92 warn "Can't make a release with MANIFEST files missing:\n"; 93 warn "\t".$_."\n" for (@missfile); 94} 95die "Aborted.\n" if @missfile; 96print "\n"; 97 98# VMS no longer has hardcoded version numbers descrip.mms 99 100print "Creating $relroot/$reldir release directory...\n"; 101die "$relroot/$reldir release directory already exists [consider using -c]\n" if -e "$relroot/$reldir"; 102die "$relroot/$reldir.tar.gz release file already exists [consider using -c]\n" if -e "$relroot/$reldir.tar.gz"; 103die "$relroot/$reldir.tar.xz release file already exists [consider using -c]\n" if $opts{x} && -e "$relroot/$reldir.tar.xz"; 104mkdir("$relroot/$reldir", 0755) or die "mkdir $relroot/$reldir: $!\n"; 105print "\n"; 106 107 108print "Copying files to release directory...\n"; 109# ExtUtils::Manifest maniread does not preserve the order 110my $cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $relroot/$reldir"; 111system($cmd) == 0 112 or die "$cmd failed"; 113print "\n"; 114 115chdir "$relroot/$reldir" or die $!; 116 117my @exe = map { my ($f) = split; glob($f) } 118 grep { $_ !~ /\A#/ && $_ !~ /\A\s*\z/ } 119 map { split "\n" } 120 do { local (@ARGV, $/) = 'Porting/exec-bit.txt'; <> }; 121 122if ($opts{e}) { 123 require './regen/charset_translations.pl'; 124 125 # Translation tables, so far only to 1047 126 my @charset = grep { /1047/ } get_supported_code_pages(); 127 128 my $charset = $charset[0]; 129 my $a2e = get_a2n($charset); 130 131 die "$0 must be run on an ASCII platform" if ord("A") != 65; 132 133 print "Translating to EBCDIC...\n"; 134 135 open my $mani_fh, "<", "MANIFEST" or die "Can't read copied MANIFEST: $!"; 136 my @manifest = <$mani_fh>; # Slurp in whole thing before the file gets trashed 137 close $mani_fh or die "Couldn't close MANIFEST: $!"; 138 while (defined ($_ = shift @manifest)) { 139 chomp; 140 my $file = $_ =~ s/\s.*//r; # Rmv description to get just the file 141 # name 142 143 local $/; # slurp mode 144 open my $fh, "+<:raw", $file or die "Can't read copied $file: $!"; 145 my $text = <$fh>; 146 my $xlated = ""; 147 my $utf16_high = 0; 148 my $utf16_low = 0; 149 150 my $potential_BOM = substr($text, 0, 2); 151 if ($potential_BOM eq "\xFE\xFF") { 152 $utf16_high = 0; 153 $utf16_low = 1; 154 print STDERR "$file is UTF-16BE\n"; 155 } 156 elsif ($potential_BOM eq "\xFF\xFE") { 157 $utf16_high = 1; 158 $utf16_low = 0; 159 print STDERR "$file is UTF-16LE\n"; 160 } 161 162 if ($utf16_high || $utf16_low) { 163 my $len = length $text; 164 die "Odd length in UTF-16 files: $file" if $len % 2; 165 166 # Look 2 bytes at a time 167 for (my $i = 0; $i < $len; $i+=2) { 168 my $cur = substr($text, $i, 2); 169 170 # If the code point's high byte is 0, it means the code point 171 # itself is 00-FF, so want native value of it. 172 if (substr($cur, $utf16_high, 1) eq "\0") { 173 174 # Just substitute the translated native value 175 my $low_byte = substr($cur, $utf16_low, 1); 176 $low_byte = chr $a2e->[ord $low_byte]; 177 substr($cur, $utf16_low, 1) = $low_byte; 178 } 179 180 $xlated .= $cur; 181 } 182 } 183 elsif (-B $file) { # Binary files aren't translated 184 print STDERR "$file is binary\n"; 185 close $fh or die "Couldn't close $file: $!"; 186 next; 187 } 188 else { 189 if ( ! utf8::decode($text) 190 || $text =~ / ^ [[:ascii:][:cntrl:]]* $ /x) 191 { 192 # Here, either $text isn't legal UTF-8; or it is, but it 193 # consists entirely of one of the 160 ASCII and control 194 # characters whose EBCDIC representation is the same whether 195 # UTF-EBCDIC or not. This means we just translate 196 # byte-by-byte from Latin1 to EBCDIC. 197 $xlated = ($text =~ s/(.)/chr $a2e->[ord $1]/rsge); 198 } 199 else { 200 201 # Here, $text is legal UTF-8, and the representation of some 202 # character(s) in it it matters if is encoded in UTF-EBCDIC or 203 # not. Also, the decode caused $text to now be viewed as 204 # UTF-8 characters instead of the input bytes. We convert to 205 # UTF-EBCDIC. 206 $xlated = ($text =~ s/(.)/cp_2_utfbytes(ord $1, $charset)/rsge); 207 } 208 } 209 210 # Overwrite the file with the translation 211 truncate $fh, 0; 212 seek $fh, 0, 0; 213 print $fh $xlated; 214 215 close $fh or die "Couldn't close $file: $!"; 216 } 217} 218 219print "Setting file permissions...\n"; 220system("find . -type f -print | xargs chmod 0444"); 221system("find . -type d -print | xargs chmod 0755"); 222 223system("chmod +x @exe") == 0 224 or die "system: $!"; 225 226# MANIFEST may be resorted, so needs to be writable 227my @writables = qw( 228 feature.h 229 lib/feature.pm 230 keywords.h 231 keywords.c 232 MANIFEST 233 opcode.h 234 opnames.h 235 pp_proto.h 236 proto.h 237 embed.h 238 embedvar.h 239 overload.inc 240 overload.h 241 mg_vtable.h 242 dist/Devel-PPPort/module2.c 243 dist/Devel-PPPort/module3.c 244 cpan/autodie/t/touch_me 245 reentr.c 246 reentr.h 247 regcharclass.h 248 regnodes.h 249 warnings.h 250 lib/warnings.pm 251 win32/GNUmakefile 252 win32/Makefile 253 win32/config_H.gc 254 win32/config_H.vc 255 uconfig.h 256); 257 258my $out = `chmod u+w @writables 2>&1`; 259if ($? != 0) { 260 warn $out; 261 if ($out =~ /no such file/i) { 262 warn "Check that the files above still exist in the Perl core.\n"; 263 warn "If not, remove them from \@writables in Porting/makerel\n"; 264 } 265 exit 1; 266} 267 268warn $out if $out; 269 270chdir ".." or die $!; 271 272exit if $opts{n}; 273 274my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch 275 276my $output_7z; 277my $have_7z; 278if (! $opts{e}) { 279 print "Checking if you have 7z...\n"; 280 $output_7z = `7z 2>&1`; 281 $have_7z = defined $output_7z && $output_7z =~ /7-Zip/; 282} 283 284print "Checking if you have advdef...\n"; 285my $output_advdef = `advdef --version 2>&1`; 286my $have_advdef = defined $output_advdef && $output_advdef =~ /advancecomp/; 287 288if (! $opts{e} && $have_7z) { 289 print "Creating and compressing the tar.gz file with 7z...\n"; 290 $cmd = "tar cf - $reldir | 7z a -tgzip -mx9 -bd -si $reldir.tar.gz"; 291 system($cmd) == 0 or die "$cmd failed"; 292} else { 293 print "Creating and compressing the tar.gz file...\n"; 294 my $extra_opts = ""; 295 if ($opts{e}) { 296 print "(Using ustar format since is for an EBCDIC box)\n"; 297 $extra_opts = ' --format=ustar'; 298 } 299 $cmd = "tar cf - $extra_opts $reldir | gzip --best > $reldir.tar.gz"; 300 system($cmd) == 0 or die "$cmd failed"; 301 if ($have_advdef) { 302 print "Recompressing the tar.gz file with advdef...\n"; 303 $cmd = "advdef -z -4 $reldir.tar.gz"; 304 system($cmd) == 0 or die "$cmd failed"; 305 } 306} 307 308if ($opts{x}) { 309 print "Creating and compressing the tar.xz file with xz...\n"; 310 $cmd = "tar cf - $reldir | xz -z -c > $reldir.tar.xz"; 311 system($cmd) == 0 or die "$cmd failed"; 312} 313 314print "\n"; 315 316system("ls -ld $perl*"); 317print "\n"; 318 319my @files = glob "'$perl*.tar.*'"; 320for my $file (@files) { 321 my $sha = Digest::SHA->new('sha256'); 322 $sha->addfile($file, 'b'); 323 print $sha->hexdigest . " $file\n"; 324} 325 326sub cleanup { 327 my ( $relroot, $reldir ) = @_; 328 329 require File::Path; 330 331 my @cmds = ( 332 [ qw{make distclean} ], 333 [ qw{git clean -dxf} ], 334 ); 335 336 foreach my $cmd (@cmds) { 337 print join( ' ', "Running:", @$cmd, "\n" ); 338 system @$cmd; 339 die "fail to run ".(join(' ', @$cmd) ) unless $? == 0; 340 } 341 342 if ( -d "$relroot/$reldir" ) { 343 print "Removing directory $relroot/$reldir\n"; 344 File::Path::rmtree("$relroot/$reldir"); 345 } 346 347 # always clean both 348 my @files = ( "$relroot/$reldir.tar.gz", "$relroot/$reldir.tar.xz" ); 349 350 foreach my $f ( @files ) { 351 next unless -f $f; 352 print "Removing file '$f'\n"; 353 unlink($f); 354 } 355 356 return; 357 358} 359 3601; 361