Porting/makerel

   1 #!/usr/bin/perl -w
   2
   3 # A tool to build a perl release tarball
   4 # Very basic but functional - if you're on a unix system.
   5 #
   6 # If you're on Win32 then it should still work, but various Unix command-line
   7 # tools will need to be available somewhere. An obvious choice is to install
   8 # Cygwin and ensure its 'bin' folder is on the PATH in the shell where you run
   9 # this script. The Cygwin 'bin' folder needs to precede the Windows 'system32'
  10 # folder so that Cygwin's 'find' command is found in preference to the Windows
  11 # 'find' command. In addition to the commands installed by default, your Cygwin
  12 # installation will need to contain at least the 'cpio' and '7z' commands.
  13 # Finally, ensure that the 'awk', 'shasum' (if you have it) and '7z' commands
  14 # are copies of 'gawk.exe', 'sha1sum.exe' and 'lib\p7zip\7z.exe' respectively,
  15 # rather than the links to them that only work in a Cygwin bash shell which
  16 # they are by default.
  17 #
  18 # No matter how automated this gets, you'll always need to read
  19 # and re-read pumpkin.pod and release_managers_guide.pod to
  20 # check for things to be done at various stages of the process.
  21 #
  22 # Tim Bunce, June 1997
  23
  24 # Translation tables, so far only to 1047
  25 my @a2e = (     # ASCII to EBCDIC CP 1047
  26 0x00,0x01,0x02,0x03,0x37,0x2D,0x2E,0x2F,0x16,0x05,0x15,0x0B,0x0C,0x0D,0x0E,0x0F,
  27 0x10,0x11,0x12,0x13,0x3C,0x3D,0x32,0x26,0x18,0x19,0x3F,0x27,0x1C,0x1D,0x1E,0x1F,
  28 0x40,0x5A,0x7F,0x7B,0x5B,0x6C,0x50,0x7D,0x4D,0x5D,0x5C,0x4E,0x6B,0x60,0x4B,0x61,
  29 0xF0,0xF1,0xF2,0xF3,0xF4,0xF5,0xF6,0xF7,0xF8,0xF9,0x7A,0x5E,0x4C,0x7E,0x6E,0x6F,
  30 0x7C,0xC1,0xC2,0xC3,0xC4,0xC5,0xC6,0xC7,0xC8,0xC9,0xD1,0xD2,0xD3,0xD4,0xD5,0xD6,
  31 0xD7,0xD8,0xD9,0xE2,0xE3,0xE4,0xE5,0xE6,0xE7,0xE8,0xE9,0xAD,0xE0,0xBD,0x5F,0x6D,
  32 0x79,0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x91,0x92,0x93,0x94,0x95,0x96,
  33 0x97,0x98,0x99,0xA2,0xA3,0xA4,0xA5,0xA6,0xA7,0xA8,0xA9,0xC0,0x4F,0xD0,0xA1,0x07,
  34 0x20,0x21,0x22,0x23,0x24,0x25,0x06,0x17,0x28,0x29,0x2A,0x2B,0x2C,0x09,0x0A,0x1B,
  35 0x30,0x31,0x1A,0x33,0x34,0x35,0x36,0x08,0x38,0x39,0x3A,0x3B,0x04,0x14,0x3E,0xFF,
  36 0x41,0xAA,0x4A,0xB1,0x9F,0xB2,0x6A,0xB5,0xBB,0xB4,0x9A,0x8A,0xB0,0xCA,0xAF,0xBC,
  37 0x90,0x8F,0xEA,0xFA,0xBE,0xA0,0xB6,0xB3,0x9D,0xDA,0x9B,0x8B,0xB7,0xB8,0xB9,0xAB,
  38 0x64,0x65,0x62,0x66,0x63,0x67,0x9E,0x68,0x74,0x71,0x72,0x73,0x78,0x75,0x76,0x77,
  39 0xAC,0x69,0xED,0xEE,0xEB,0xEF,0xEC,0xBF,0x80,0xFD,0xFE,0xFB,0xFC,0xBA,0xAE,0x59,
  40 0x44,0x45,0x42,0x46,0x43,0x47,0x9C,0x48,0x54,0x51,0x52,0x53,0x58,0x55,0x56,0x57,
  41 0x8C,0x49,0xCD,0xCE,0xCB,0xCF,0xCC,0xE1,0x70,0xDD,0xDE,0xDB,0xDC,0x8D,0x8E,0xDF
  42 );
  43
  44 my @i8_2_e = (   # UTF-EBCDIC I8 to EBCDIC CP 1047
  45 0x00,0x01,0x02,0x03,0x37,0x2D,0x2E,0x2F,0x16,0x05,0x15,0x0B,0x0C,0x0D,0x0E,0x0F,
  46 0x10,0x11,0x12,0x13,0x3C,0x3D,0x32,0x26,0x18,0x19,0x3F,0x27,0x1C,0x1D,0x1E,0x1F,
  47 0x40,0x5A,0x7F,0x7B,0x5B,0x6C,0x50,0x7D,0x4D,0x5D,0x5C,0x4E,0x6B,0x60,0x4B,0x61,
  48 0xF0,0xF1,0xF2,0xF3,0xF4,0xF5,0xF6,0xF7,0xF8,0xF9,0x7A,0x5E,0x4C,0x7E,0x6E,0x6F,
  49 0x7C,0xC1,0xC2,0xC3,0xC4,0xC5,0xC6,0xC7,0xC8,0xC9,0xD1,0xD2,0xD3,0xD4,0xD5,0xD6,
  50 0xD7,0xD8,0xD9,0xE2,0xE3,0xE4,0xE5,0xE6,0xE7,0xE8,0xE9,0xAD,0xE0,0xBD,0x5F,0x6D,
  51 0x79,0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x91,0x92,0x93,0x94,0x95,0x96,
  52 0x97,0x98,0x99,0xA2,0xA3,0xA4,0xA5,0xA6,0xA7,0xA8,0xA9,0xC0,0x4F,0xD0,0xA1,0x07,
  53 0x20,0x21,0x22,0x23,0x24,0x25,0x06,0x17,0x28,0x29,0x2A,0x2B,0x2C,0x09,0x0A,0x1B,
  54 0x30,0x31,0x1A,0x33,0x34,0x35,0x36,0x08,0x38,0x39,0x3A,0x3B,0x04,0x14,0x3E,0xFF,
  55 0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4A,0x51,0x52,0x53,0x54,0x55,0x56,
  56 0x57,0x58,0x59,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6A,0x70,0x71,0x72,0x73,
  57 0x74,0x75,0x76,0x77,0x78,0x80,0x8A,0x8B,0x8C,0x8D,0x8E,0x8F,0x90,0x9A,0x9B,0x9C,
  58 0x9D,0x9E,0x9F,0xA0,0xAA,0xAB,0xAC,0xAE,0xAF,0xB0,0xB1,0xB2,0xB3,0xB4,0xB5,0xB6,
  59 0xB7,0xB8,0xB9,0xBA,0xBB,0xBC,0xBE,0xBF,0xCA,0xCB,0xCC,0xCD,0xCE,0xCF,0xDA,0xDB,
  60 0xDC,0xDD,0xDE,0xDF,0xE1,0xEA,0xEB,0xEC,0xED,0xEE,0xEF,0xFA,0xFB,0xFC,0xFD,0xFE
  61 );
  62
  63 use ExtUtils::Manifest qw(fullcheck);
  64 $ExtUtils::Manifest::Quiet = 1;
  65 use Getopt::Std;
  66
  67 $|=1;
  68
  69 sub usage { die <<EOF; }
  70 usage: $0 [ -r rootdir ] [-s suffix ] [ -x ] [ -n ]
  71     -r rootdir   directory under which to create the build dir and tarball
  72                  defaults to '..'
  73     -s suffix    suffix to append to the perl-x.y.z dir and tarball name
  74                  defaults to the concatenation of the local_patches entry
  75                  in patchlevel.h (or blank, if none)
  76     -x           make a .xz file in addition to a .gz file
  77     -n           do not make any tarballs, just the directory
  78     -c cleanup   perform a cleanup before building: clean git repo and target
  79                  directory/tarballs
  80     -e           Make the outputs be translated into EBCDIC.  (They can then
  81                  be downloaded directly to an EBCDIC platform without needing
  82                  any further translation.)
  83 EOF
  84
  85 my %opts;
  86 getopts('exncr:s:', \%opts) or usage;
  87
  88 @ARGV && usage;
  89
  90 $relroot = defined $opts{r} ? $opts{r} : "..";
  91
  92 die "Must be in root of the perl source tree.\n"
  93         unless -f "./MANIFEST" and -f "patchlevel.h";
  94
  95 open PATCHLEVEL, '<', 'patchlevel.h' or die;
  96 my @patchlevel_h = <PATCHLEVEL>;
  97 close PATCHLEVEL;
  98 my $patchlevel_h = join "", grep { /^#\s*define/ } @patchlevel_h;
  99 print $patchlevel_h;
 100 $revision = $1 if $patchlevel_h =~ /PERL_REVISION\s+(\d+)/;
 101 $patchlevel = $1 if $patchlevel_h =~ /PERL_VERSION\s+(\d+)/;
 102 $subversion = $1 if $patchlevel_h =~ /PERL_SUBVERSION\s+(\d+)/;
 103 die "Unable to parse patchlevel.h" unless $subversion >= 0;
 104 $vers = sprintf("%d.%d.%d", $revision, $patchlevel, $subversion);
 105
 106 # fetch list of local patches
 107 my (@local_patches, @lpatch_tags, $lpatch_tags);
 108 @local_patches = grep { !/^\s*,?NULL/ && ! /,"uncommitted-changes"/ }
 109                  grep { /^static.*local_patches/../^};/ }
 110                  @patchlevel_h;
 111 @lpatch_tags   = map  {  /^\s*,"(\w+)/ } @local_patches;
 112 $lpatch_tags   = join "-", @lpatch_tags;
 113
 114 $perl = "perl-$vers";
 115 $reldir = "$perl";
 116
 117 $lpatch_tags = $opts{s} if defined $opts{s};
 118 $reldir .= "-$lpatch_tags" if $lpatch_tags;
 119
 120 print "\nMaking a release for $perl in $relroot/$reldir\n\n";
 121
 122 cleanup($relroot, $reldir) if $opts{c};
 123
 124 print "Cross-checking the MANIFEST...\n";
 125 ($missfile, $missentry) = fullcheck();
 126 @$missentry
 127     = grep {$_ !~ m!^\.(?:git|github|mailmap)! and $_ !~ m!(?:/|^)\.gitignore!} @$missentry;
 128 if (@$missfile ) {
 129     warn "Can't make a release with MANIFEST files missing:\n";
 130     warn "\t".$_."\n" for (@$missfile);
 131 }
 132 if (@$missentry ) {
 133     warn "Can't make a release with files not listed in MANIFEST\n";
 134     warn "\t".$_."\n" for (@$missentry);
 135
 136 }
 137 if ("@$missentry" =~ m/\.orig\b/) {
 138     # Handy listing of find command and .orig files from patching work.
 139     # I tend to run 'xargs rm' and copy and paste the file list.
 140     my $cmd = "find . -name '*.orig' -print";
 141     print "$cmd\n";
 142     system($cmd);
 143 }
 144 die "Aborted.\n" if @$missentry or @$missfile;
 145 print "\n";
 146
 147 # VMS no longer has hardcoded version numbers descrip.mms
 148
 149 print "Creating $relroot/$reldir release directory...\n";
 150 die "$relroot/$reldir release directory already exists [consider using -c]\n"   if -e "$relroot/$reldir";
 151 die "$relroot/$reldir.tar.gz release file already exists [consider using -c]\n" if -e "$relroot/$reldir.tar.gz";
 152 die "$relroot/$reldir.tar.xz release file already exists [consider using -c]\n" if $opts{x} && -e "$relroot/$reldir.tar.xz";
 153 mkdir("$relroot/$reldir", 0755) or die "mkdir $relroot/$reldir: $!\n";
 154 print "\n";
 155
 156
 157 print "Copying files to release directory...\n";
 158 # ExtUtils::Manifest maniread does not preserve the order
 159 $cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $relroot/$reldir";
 160 system($cmd) == 0
 161     or die "$cmd failed";
 162 print "\n";
 163
 164 chdir "$relroot/$reldir" or die $!;
 165
 166 my @exe = map   { my ($f) = split; glob($f) }
 167           grep  { $_ !~ /\A#/ && $_ !~ /\A\s*\z/ }
 168           map   { split "\n" }
 169           do    { local (@ARGV, $/) = 'Porting/exec-bit.txt'; <> };
 170
 171 if ($opts{e}) {
 172     die "$0 must be run on an ASCII platform" if ord("A") != 65;
 173
 174     print "Translating to EBCDIC...\n";
 175
 176     open my $mani_fh, "<", "MANIFEST" or die "Can't read copied MANIFEST: $!";
 177     my @manifest = <$mani_fh>;  # Slurp in whole thing before the file gets trashed
 178     close $mani_fh or die "Couldn't close MANIFEST: $!";
 179     while (defined ($_ = shift @manifest)) {
 180         chomp;
 181         my $file = $_ =~ s/\s.*//r; # Rmv description to get just the file
 182                                     # name
 183         print STDERR "$file is binary\n" if -B $file;   # Binary files aren't translated
 184         next if -B $file;   # Binary files aren't translated
 185
 186         local $/; # slurp mode
 187         open my $fh, "+<:raw", $file or die "Can't read copied $file: $!";
 188         my $text = <$fh>;
 189         my $xlated = "";
 190
 191         if (! utf8::decode($text) || $text =~ / ^ [[:ascii:][:cntrl:]]* $ /x) {
 192
 193             # Here, either $text isn't legal UTF-8; or it is, but it consists
 194             # entirely of one of the 160 ASCII and control characters whose
 195             # EBCDIC representation is the same whether UTF-EBCDIC or not.
 196             # This means we just translate 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 not.
 203             # Also, the decode caused $text to now be viewed as UTF-8 characters
 204             # instead of the input bytes.  We convert to UTF-EBCDIC.
 205
 206             while ($text =~ m/(.)/gs) {
 207                 my $ord = ord $1;
 208                 if ($ord < 0xA0) {  # UTF-EBCDIC invariant
 209                     $xlated .= chr $a2e[$ord];
 210                     next;
 211                 }
 212
 213                 # Get how many bytes (1 start + n continuations) its
 214                 # representation is, and the start mark, which consists of the
 215                 # upper n+1 bits being 1
 216                 my $start_mark;
 217                 my $conts;
 218                 if ($ord < 0x400) {
 219                     $start_mark = 0xC0;
 220                     $conts = 1;
 221                 }
 222                 elsif ($ord < 0x4000) {
 223                     $start_mark = 0xE0;
 224                     $conts = 2;
 225                 }
 226                 elsif ($ord < 0x40000) {
 227                     $start_mark = 0xF0;
 228                     $conts = 3;
 229                 }
 230                 elsif ($ord < 0x400000) {
 231                     $start_mark = 0xF8;
 232                     $conts = 4;
 233                 }
 234                 elsif ($ord < 0x4000000) {
 235                     $start_mark = 0xFC;
 236                     $conts = 5;
 237                 }
 238                 elsif ($ord < 0x40000000) {
 239                     $start_mark = 0xFE;
 240                     $conts = 6;
 241                 }
 242                 else {
 243                     $start_mark = 0xFF;
 244                     $conts = 13;
 245                 }
 246
 247                 # Use the underlying I8 fundamentals to get each byte of the I8
 248                 # representation, then convert that to native with @i8_2_e
 249                 my @i8;
 250                 while ($conts-- > 0) {  # First the continuations
 251                     unshift @i8, chr($i8_2_e[0xA0 | ($ord & 0x1F)]);
 252                     $ord >>= 5
 253                 }
 254
 255                 # Then the start byte
 256                 unshift @i8, chr($i8_2_e[$start_mark | $ord]);
 257                 $xlated .= join "", @i8;
 258             }
 259         } # End of loop through the file
 260
 261         # Overwrite it with the translation
 262         truncate $fh, 0;
 263         seek $fh, 0, 0;
 264         print $fh $xlated;
 265
 266         close $fh or die "Couldn't close $file: $!";
 267     }
 268 }
 269
 270 print "Setting file permissions...\n";
 271 system("find . -type f -print     | xargs chmod 0444");
 272 system("find . -type d -print     | xargs chmod 0755");
 273
 274 system("chmod +x @exe") == 0
 275     or die "system: $!";
 276
 277 # MANIFEST may be resorted, so needs to be writable
 278 my @writables = qw(
 279     NetWare/config_H.wc
 280     NetWare/Makefile
 281     feature.h
 282     lib/feature.pm
 283     keywords.h
 284     keywords.c
 285     MANIFEST
 286     opcode.h
 287     opnames.h
 288     pp_proto.h
 289     proto.h
 290     embed.h
 291     embedvar.h
 292     overload.inc
 293     overload.h
 294     mg_vtable.h
 295     dist/Devel-PPPort/module2.c
 296     dist/Devel-PPPort/module3.c
 297     cpan/autodie/t/touch_me
 298     reentr.c
 299     reentr.h
 300     regcharclass.h
 301     regnodes.h
 302     warnings.h
 303     lib/warnings.pm
 304     win32/GNUmakefile
 305     win32/Makefile
 306     win32/makefile.mk
 307     win32/config_H.gc
 308     win32/config_H.vc
 309     uconfig.h
 310 );
 311
 312 my $out = `chmod u+w @writables 2>&1`;
 313 if ($? != 0) {
 314     warn $out;
 315     if ($out =~ /no such file/i) {
 316         warn "Check that the files above still exist in the Perl core.\n";
 317         warn "If not, remove them from \@writables in Porting/makerel\n";
 318     }
 319     exit 1;
 320 }
 321
 322 warn $out if $out;
 323
 324 chdir ".." or die $!;
 325
 326 exit if $opts{n};
 327
 328 my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch
 329
 330 my $output_7z;
 331 my $have_7z;
 332 if (! $opts{e}) {
 333     print "Checking if you have 7z...\n";
 334     $output_7z = `7z 2>&1`;
 335     $have_7z = defined $output_7z && $output_7z =~ /7-Zip/;
 336 }
 337
 338 print "Checking if you have advdef...\n";
 339 my $output_advdef = `advdef --version 2>&1`;
 340 my $have_advdef = defined $output_advdef && $output_advdef =~ /advancecomp/;
 341
 342 if (! $opts{e} && $have_7z) {
 343     print "Creating and compressing the tar.gz file with 7z...\n";
 344     $cmd = "tar cf - $reldir | 7z a -tgzip -mx9 -bd -si $reldir.tar.gz";
 345     system($cmd) == 0 or die "$cmd failed";
 346 } else {
 347     print "Creating and compressing the tar.gz file...\n";
 348     my $extra_opts = "";
 349     if ($opts{e}) {
 350         print "(Using ustar format since is for an EBCDIC box)\n";
 351         $extra_opts = ' --format=ustar';
 352     }
 353     $cmd = "tar cf - $extra_opts $reldir | gzip --best > $reldir.tar.gz";
 354     system($cmd) == 0 or die "$cmd failed";
 355     if ($have_advdef) {
 356         print "Recompressing the tar.gz file with advdef...\n";
 357         $cmd = "advdef -z -4 $reldir.tar.gz";
 358         system($cmd) == 0 or die "$cmd failed";
 359     }
 360 }
 361
 362 if ($opts{x}) {
 363     print "Creating and compressing the tar.xz file with xz...\n";
 364     $cmd = "tar cf - $reldir | xz -z -c > $reldir.tar.xz";
 365     system($cmd) == 0 or die "$cmd failed";
 366 }
 367
 368 print "\n";
 369
 370 system("ls -ld $perl*");
 371 print "\n";
 372
 373 my $null = $^O eq 'MSWin32' ? 'NUL' : '/dev/null';
 374 for my $sha (qw(sha1 shasum sha1sum)) {
 375     if (`which $sha 2>$null`) {
 376         system("$sha $perl*.tar.*");
 377         last;
 378     }
 379 }
 380
 381 sub cleanup {
 382     my ( $relroot, $reldir ) = @_;
 383
 384     require File::Path;
 385
 386     my @cmds = (
 387         [ qw{make distclean} ],
 388         [ qw{git clean -dxf} ],
 389     );
 390
 391     foreach my $cmd (@cmds) {
 392         print join( ' ', "Running:", @$cmd, "\n" );
 393         system @$cmd;
 394         die "fail to run ".(join(' ', @$cmd) ) unless $? == 0;
 395     }
 396
 397     if ( -d "$relroot/$reldir" ) {
 398         print "Removing directory $relroot/$reldir\n";
 399         File::Path::rmtree("$relroot/$reldir");
 400     }
 401
 402     # always clean both
 403     my @files = ( "$relroot/$reldir.tar.gz", "$relroot/$reldir.tar.xz" );
 404
 405     foreach my $f ( @files ) {
 406         next unless -f $f;
 407         print "Removing file '$f'\n";
 408         unlink($f);
 409     }
 410
 411     return;
 412
 413 }
 414
 415 1;