Porting/makerel

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