[perl5.git] / Porting / makerel

#!/usr/bin/perl -w

# A tool to build a perl release tarball
# Very basic but functional - if you're on a unix system.
#
# If you're on Win32 then it should still work, but various Unix command-line
# tools will need to be available somewhere. An obvious choice is to install
# Cygwin and ensure its 'bin' folder is on the PATH in the shell where you run
# this script. The Cygwin 'bin' folder needs to precede the Windows 'system32'
# folder so that Cygwin's 'find' command is found in preference to the Windows
# 'find' command. In addition to the commands installed by default, your Cygwin
# installation will need to contain at least the 'cpio' and '7z' commands.
# Finally, ensure that the 'awk', 'shasum' (if you have it) and '7z' commands
# are copies of 'gawk.exe', 'sha1sum.exe' and 'lib\p7zip\7z.exe' respectively,
# rather than the links to them that only work in a Cygwin bash shell which
# they are by default.
#
# No matter how automated this gets, you'll always need to read
# and re-read pumpkin.pod and release_managers_guide.pod to
# check for things to be done at various stages of the process.
#
# Tim Bunce, June 1997

# Translation tables, so far only to 1047
my @a2e = (     # ASCII to EBCDIC CP 1047
0x00,0x01,0x02,0x03,0x37,0x2D,0x2E,0x2F,0x16,0x05,0x15,0x0B,0x0C,0x0D,0x0E,0x0F,
0x10,0x11,0x12,0x13,0x3C,0x3D,0x32,0x26,0x18,0x19,0x3F,0x27,0x1C,0x1D,0x1E,0x1F,
0x40,0x5A,0x7F,0x7B,0x5B,0x6C,0x50,0x7D,0x4D,0x5D,0x5C,0x4E,0x6B,0x60,0x4B,0x61,
0xF0,0xF1,0xF2,0xF3,0xF4,0xF5,0xF6,0xF7,0xF8,0xF9,0x7A,0x5E,0x4C,0x7E,0x6E,0x6F,
0x7C,0xC1,0xC2,0xC3,0xC4,0xC5,0xC6,0xC7,0xC8,0xC9,0xD1,0xD2,0xD3,0xD4,0xD5,0xD6,
0xD7,0xD8,0xD9,0xE2,0xE3,0xE4,0xE5,0xE6,0xE7,0xE8,0xE9,0xAD,0xE0,0xBD,0x5F,0x6D,
0x79,0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x91,0x92,0x93,0x94,0x95,0x96,
0x97,0x98,0x99,0xA2,0xA3,0xA4,0xA5,0xA6,0xA7,0xA8,0xA9,0xC0,0x4F,0xD0,0xA1,0x07,
0x20,0x21,0x22,0x23,0x24,0x25,0x06,0x17,0x28,0x29,0x2A,0x2B,0x2C,0x09,0x0A,0x1B,
0x30,0x31,0x1A,0x33,0x34,0x35,0x36,0x08,0x38,0x39,0x3A,0x3B,0x04,0x14,0x3E,0xFF,
0x41,0xAA,0x4A,0xB1,0x9F,0xB2,0x6A,0xB5,0xBB,0xB4,0x9A,0x8A,0xB0,0xCA,0xAF,0xBC,
0x90,0x8F,0xEA,0xFA,0xBE,0xA0,0xB6,0xB3,0x9D,0xDA,0x9B,0x8B,0xB7,0xB8,0xB9,0xAB,
0x64,0x65,0x62,0x66,0x63,0x67,0x9E,0x68,0x74,0x71,0x72,0x73,0x78,0x75,0x76,0x77,
0xAC,0x69,0xED,0xEE,0xEB,0xEF,0xEC,0xBF,0x80,0xFD,0xFE,0xFB,0xFC,0xBA,0xAE,0x59,
0x44,0x45,0x42,0x46,0x43,0x47,0x9C,0x48,0x54,0x51,0x52,0x53,0x58,0x55,0x56,0x57,
0x8C,0x49,0xCD,0xCE,0xCB,0xCF,0xCC,0xE1,0x70,0xDD,0xDE,0xDB,0xDC,0x8D,0x8E,0xDF
);

my @i8_2_e = (   # UTF-EBCDIC I8 to EBCDIC CP 1047
0x00,0x01,0x02,0x03,0x37,0x2D,0x2E,0x2F,0x16,0x05,0x15,0x0B,0x0C,0x0D,0x0E,0x0F,
0x10,0x11,0x12,0x13,0x3C,0x3D,0x32,0x26,0x18,0x19,0x3F,0x27,0x1C,0x1D,0x1E,0x1F,
0x40,0x5A,0x7F,0x7B,0x5B,0x6C,0x50,0x7D,0x4D,0x5D,0x5C,0x4E,0x6B,0x60,0x4B,0x61,
0xF0,0xF1,0xF2,0xF3,0xF4,0xF5,0xF6,0xF7,0xF8,0xF9,0x7A,0x5E,0x4C,0x7E,0x6E,0x6F,
0x7C,0xC1,0xC2,0xC3,0xC4,0xC5,0xC6,0xC7,0xC8,0xC9,0xD1,0xD2,0xD3,0xD4,0xD5,0xD6,
0xD7,0xD8,0xD9,0xE2,0xE3,0xE4,0xE5,0xE6,0xE7,0xE8,0xE9,0xAD,0xE0,0xBD,0x5F,0x6D,
0x79,0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x91,0x92,0x93,0x94,0x95,0x96,
0x97,0x98,0x99,0xA2,0xA3,0xA4,0xA5,0xA6,0xA7,0xA8,0xA9,0xC0,0x4F,0xD0,0xA1,0x07,
0x20,0x21,0x22,0x23,0x24,0x25,0x06,0x17,0x28,0x29,0x2A,0x2B,0x2C,0x09,0x0A,0x1B,
0x30,0x31,0x1A,0x33,0x34,0x35,0x36,0x08,0x38,0x39,0x3A,0x3B,0x04,0x14,0x3E,0xFF,
0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4A,0x51,0x52,0x53,0x54,0x55,0x56,
0x57,0x58,0x59,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6A,0x70,0x71,0x72,0x73,
0x74,0x75,0x76,0x77,0x78,0x80,0x8A,0x8B,0x8C,0x8D,0x8E,0x8F,0x90,0x9A,0x9B,0x9C,
0x9D,0x9E,0x9F,0xA0,0xAA,0xAB,0xAC,0xAE,0xAF,0xB0,0xB1,0xB2,0xB3,0xB4,0xB5,0xB6,
0xB7,0xB8,0xB9,0xBA,0xBB,0xBC,0xBE,0xBF,0xCA,0xCB,0xCC,0xCD,0xCE,0xCF,0xDA,0xDB,
0xDC,0xDD,0xDE,0xDF,0xE1,0xEA,0xEB,0xEC,0xED,0xEE,0xEF,0xFA,0xFB,0xFC,0xFD,0xFE
);

use ExtUtils::Manifest qw(fullcheck);
$ExtUtils::Manifest::Quiet = 1;
use Getopt::Std;

$|=1;

sub usage { die <<EOF; }
usage: $0 [ -r rootdir ] [-s suffix ] [ -x ] [ -n ]
    -r rootdir   directory under which to create the build dir and tarball
                 defaults to '..'
    -s suffix    suffix to append to the perl-x.y.z dir and tarball name
		 defaults to the concatenation of the local_patches entry
		 in patchlevel.h (or blank, if none)
    -x           make a .xz file in addition to a .gz file
    -n           do not make any tarballs, just the directory
    -c cleanup   perform a cleanup before building: clean git repo and target
                 directory/tarballs
    -e           Make the outputs be translated into EBCDIC.  (They can then
                 be downloaded directly to an EBCDIC platform without needing
                 any further translation.)
EOF

my %opts;
getopts('exncr:s:', \%opts) or usage;

@ARGV && usage;

$relroot = defined $opts{r} ? $opts{r} : "..";

die "Must be in root of the perl source tree.\n"
	unless -f "./MANIFEST" and -f "patchlevel.h";

open PATCHLEVEL, '<', 'patchlevel.h' or die;
my @patchlevel_h = <PATCHLEVEL>;
close PATCHLEVEL;
my $patchlevel_h = join "", grep { /^#\s*define/ } @patchlevel_h;
print $patchlevel_h;
$revision = $1 if $patchlevel_h =~ /PERL_REVISION\s+(\d+)/;
$patchlevel = $1 if $patchlevel_h =~ /PERL_VERSION\s+(\d+)/;
$subversion = $1 if $patchlevel_h =~ /PERL_SUBVERSION\s+(\d+)/;
die "Unable to parse patchlevel.h" unless $subversion >= 0;
$vers = sprintf("%d.%d.%d", $revision, $patchlevel, $subversion);

# fetch list of local patches
my (@local_patches, @lpatch_tags, $lpatch_tags);
@local_patches = grep { !/^\s*,?NULL/ && ! /,"uncommitted-changes"/ }
                 grep { /^static.*local_patches/../^};/ }
                 @patchlevel_h;
@lpatch_tags   = map  {  /^\s*,"(\w+)/ } @local_patches;
$lpatch_tags   = join "-", @lpatch_tags;

$perl = "perl-$vers";
$reldir = "$perl";

$lpatch_tags = $opts{s} if defined $opts{s};
$reldir .= "-$lpatch_tags" if $lpatch_tags;

print "\nMaking a release for $perl in $relroot/$reldir\n\n";

cleanup($relroot, $reldir) if $opts{c};

print "Cross-checking the MANIFEST...\n";
($missfile, $missentry) = fullcheck();
@$missentry
    = grep {$_ !~ m!^\.(?:git|github|mailmap)! and $_ !~ m!(?:/|^)\.gitignore!} @$missentry;
if (@$missfile ) {
    warn "Can't make a release with MANIFEST files missing:\n";
    warn "\t".$_."\n" for (@$missfile);
}
if (@$missentry ) {
    warn "Can't make a release with files not listed in MANIFEST\n";
    warn "\t".$_."\n" for (@$missentry);

}
if ("@$missentry" =~ m/\.orig\b/) {
    # Handy listing of find command and .orig files from patching work.
    # I tend to run 'xargs rm' and copy and paste the file list.
    my $cmd = "find . -name '*.orig' -print";
    print "$cmd\n";
    system($cmd);
}
die "Aborted.\n" if @$missentry or @$missfile;
print "\n";

# VMS no longer has hardcoded version numbers descrip.mms

print "Creating $relroot/$reldir release directory...\n";
die "$relroot/$reldir release directory already exists [consider using -c]\n"   if -e "$relroot/$reldir";
die "$relroot/$reldir.tar.gz release file already exists [consider using -c]\n" if -e "$relroot/$reldir.tar.gz";
die "$relroot/$reldir.tar.xz release file already exists [consider using -c]\n" if $opts{x} && -e "$relroot/$reldir.tar.xz";
mkdir("$relroot/$reldir", 0755) or die "mkdir $relroot/$reldir: $!\n";
print "\n";


print "Copying files to release directory...\n";
# ExtUtils::Manifest maniread does not preserve the order
$cmd = "awk '{print \$1}' MANIFEST | cpio -pdm $relroot/$reldir";
system($cmd) == 0
    or die "$cmd failed";
print "\n";

chdir "$relroot/$reldir" or die $!;

my @exe = map   { my ($f) = split; glob($f) }
          grep  { $_ !~ /\A#/ && $_ !~ /\A\s*\z/ }
          map   { split "\n" }
          do    { local (@ARGV, $/) = 'Porting/exec-bit.txt'; <> };

if ($opts{e}) {
    die "$0 must be run on an ASCII platform" if ord("A") != 65;

    print "Translating to EBCDIC...\n";

    open my $mani_fh, "<", "MANIFEST" or die "Can't read copied MANIFEST: $!";
    my @manifest = <$mani_fh>;  # Slurp in whole thing before the file gets trashed
    close $mani_fh or die "Couldn't close MANIFEST: $!";
    while (defined ($_ = shift @manifest)) {
        chomp;
        my $file = $_ =~ s/\s.*//r; # Rmv description to get just the file
                                    # name
        print STDERR "$file is binary\n" if -B $file;   # Binary files aren't translated
        next if -B $file;   # Binary files aren't translated

        local $/; # slurp mode
        open my $fh, "+<:raw", $file or die "Can't read copied $file: $!";
        my $text = <$fh>;
        my $xlated = "";

        if (! utf8::decode($text) || $text =~ / ^ [[:ascii:][:cntrl:]]* $ /x) {

            # Here, either $text isn't legal UTF-8; or it is, but it consists
            # entirely of one of the 160 ASCII and control characters whose
            # EBCDIC representation is the same whether UTF-EBCDIC or not.
            # This means we just translate byte-by-byte from Latin1 to EBCDIC.
            $xlated = ($text =~ s/(.)/chr $a2e[ord $1]/rsge);
        }
        else {

            # Here, $text is legal UTF-8, and the representation of some
            # character(s) in it it matters if is encoded in UTF-EBCDIC or not.
            # Also, the decode caused $text to now be viewed as UTF-8 characters
            # instead of the input bytes.  We convert to UTF-EBCDIC.

            while ($text =~ m/(.)/gs) {
                my $ord = ord $1;
                if ($ord < 0xA0) {  # UTF-EBCDIC invariant
                    $xlated .= chr $a2e[$ord];
                    next;
                }

                # Get how many bytes (1 start + n continuations) its
                # representation is, and the start mark, which consists of the
                # upper n+1 bits being 1
                my $start_mark;
                my $conts;
                if ($ord < 0x400) {
                    $start_mark = 0xC0;
                    $conts = 1;
                }
                elsif ($ord < 0x4000) {
                    $start_mark = 0xE0;
                    $conts = 2;
                }
                elsif ($ord < 0x40000) {
                    $start_mark = 0xF0;
                    $conts = 3;
                }
                elsif ($ord < 0x400000) {
                    $start_mark = 0xF8;
                    $conts = 4;
                }
                elsif ($ord < 0x4000000) {
                    $start_mark = 0xFC;
                    $conts = 5;
                }
                elsif ($ord < 0x40000000) {
                    $start_mark = 0xFE;
                    $conts = 6;
                }
                else {
                    $start_mark = 0xFF;
                    $conts = 13;
                }

                # Use the underlying I8 fundamentals to get each byte of the I8
                # representation, then convert that to native with @i8_2_e
                my @i8;
                while ($conts-- > 0) {  # First the continuations
                    unshift @i8, chr($i8_2_e[0xA0 | ($ord & 0x1F)]);
                    $ord >>= 5
                }

                # Then the start byte
                unshift @i8, chr($i8_2_e[$start_mark | $ord]);
                $xlated .= join "", @i8;
            }
        } # End of loop through the file

        # Overwrite it with the translation
        truncate $fh, 0;
        seek $fh, 0, 0;
        print $fh $xlated;

        close $fh or die "Couldn't close $file: $!";
    }
}

print "Setting file permissions...\n";
system("find . -type f -print     | xargs chmod 0444");
system("find . -type d -print     | xargs chmod 0755");

system("chmod +x @exe") == 0
    or die "system: $!";

# MANIFEST may be resorted, so needs to be writable
my @writables = qw(
    NetWare/config_H.wc
    NetWare/Makefile
    feature.h
    lib/feature.pm
    keywords.h
    keywords.c
    MANIFEST
    opcode.h
    opnames.h
    pp_proto.h
    proto.h
    embed.h
    embedvar.h
    overload.inc
    overload.h
    mg_vtable.h
    dist/Devel-PPPort/module2.c
    dist/Devel-PPPort/module3.c
    cpan/autodie/t/touch_me
    reentr.c
    reentr.h
    regcharclass.h
    regnodes.h
    warnings.h
    lib/warnings.pm
    win32/GNUmakefile
    win32/Makefile
    win32/makefile.mk
    win32/config_H.gc
    win32/config_H.vc
    uconfig.h
);

my $out = `chmod u+w @writables 2>&1`;
if ($? != 0) {
    warn $out;
    if ($out =~ /no such file/i) {
        warn "Check that the files above still exist in the Perl core.\n";
        warn "If not, remove them from \@writables in Porting/makerel\n";
    }
    exit 1;
}

warn $out if $out;

chdir ".." or die $!;

exit if $opts{n};

my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch

my $output_7z;
my $have_7z;
if (! $opts{e}) {
    print "Checking if you have 7z...\n";
    $output_7z = `7z 2>&1`;
    $have_7z = defined $output_7z && $output_7z =~ /7-Zip/;
}

print "Checking if you have advdef...\n";
my $output_advdef = `advdef --version 2>&1`;
my $have_advdef = defined $output_advdef && $output_advdef =~ /advancecomp/;

if (! $opts{e} && $have_7z) {
    print "Creating and compressing the tar.gz file with 7z...\n";
    $cmd = "tar cf - $reldir | 7z a -tgzip -mx9 -bd -si $reldir.tar.gz";
    system($cmd) == 0 or die "$cmd failed";
} else {
    print "Creating and compressing the tar.gz file...\n";
    my $extra_opts = "";
    if ($opts{e}) {
        print "(Using ustar format since is for an EBCDIC box)\n";
        $extra_opts = ' --format=ustar';
    }
    $cmd = "tar cf - $extra_opts $reldir | gzip --best > $reldir.tar.gz";
    system($cmd) == 0 or die "$cmd failed";
    if ($have_advdef) {
        print "Recompressing the tar.gz file with advdef...\n";
        $cmd = "advdef -z -4 $reldir.tar.gz";
        system($cmd) == 0 or die "$cmd failed";
    }
}

if ($opts{x}) {
    print "Creating and compressing the tar.xz file with xz...\n";
    $cmd = "tar cf - $reldir | xz -z -c > $reldir.tar.xz";
    system($cmd) == 0 or die "$cmd failed";
}

print "\n";

system("ls -ld $perl*");
print "\n";

my $null = $^O eq 'MSWin32' ? 'NUL' : '/dev/null';
for my $sha (qw(sha1 shasum sha1sum)) {
    if (`which $sha 2>$null`) {
	system("$sha $perl*.tar.*");
	last;
    }
}

sub cleanup {
    my ( $relroot, $reldir ) = @_;

    require File::Path;

    my @cmds = (
        [ qw{make distclean} ],
        [ qw{git clean -dxf} ],
    );

    foreach my $cmd (@cmds) {
        print join( ' ', "Running:", @$cmd, "\n" );
        system @$cmd;
        die "fail to run ".(join(' ', @$cmd) ) unless $? == 0;
    }

    if ( -d "$relroot/$reldir" ) {
        print "Removing directory $relroot/$reldir\n";
        File::Path::rmtree("$relroot/$reldir");
    }

    # always clean both
    my @files = ( "$relroot/$reldir.tar.gz", "$relroot/$reldir.tar.xz" );

    foreach my $f ( @files ) {
        next unless -f $f;
        print "Removing file '$f'\n";
        unlink($f);
    }

    return;

}

1;
Commit	Line	Data
23b3bd7f	1	#!/usr/bin/perl -w
08aa1457	2
63d690b1	3	# A tool to build a perl release tarball
08aa1457	4	# Very basic but functional - if you're on a unix system.
08aa1457	5	#
e8c01f92 SH	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
fbfa7c02 SH	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.
e8c01f92	17	#
08aa1457	18	# No matter how automated this gets, you'll always need to read
63d690b1 JV	19	# and re-read pumpkin.pod and release_managers_guide.pod to
63d690b1 JV	20	# check for things to be done at various stages of the process.
08aa1457	21	#
	22	# Tim Bunce, June 1997
	23
b38ce61e KW	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
08aa1457	63	use ExtUtils::Manifest qw(fullcheck);
5f244db9 DM	64	$ExtUtils::Manifest::Quiet = 1;
5f244db9 DM	65	use Getopt::Std;
08aa1457	66
08aa1457	67	$\|=1;
5f244db9 DM	68
5f244db9 DM	69	sub usage { die <<EOF; }
c6bee77e	70	usage: $0 [ -r rootdir ] [-s suffix ] [ -x ] [ -n ]
5f244db9 DM	71	-r rootdir directory under which to create the build dir and tarball
5f244db9 DM	72	defaults to '..'
a3815e44	73	-s suffix suffix to append to the perl-x.y.z dir and tarball name
47e01c32	74	defaults to the concatenation of the local_patches entry
5f244db9	75	in patchlevel.h (or blank, if none)
bb56637e	76	-x make a .xz file in addition to a .gz file
1baeb402	77	-n do not make any tarballs, just the directory
b38ce61e KW	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.)
5f244db9 DM	83	EOF
	84
	85	my %opts;
b38ce61e KW	86	getopts('exncr:s:', \%opts) or usage;
b38ce61e KW	87
5f244db9 DM	88	@ARGV && usage;
	89
	90	$relroot = defined $opts{r} ? $opts{r} : "..";
08aa1457	91
	92	die "Must be in root of the perl source tree.\n"
	93	unless -f "./MANIFEST" and -f "patchlevel.h";
	94
1ae6ead9	95	open PATCHLEVEL, '<', 'patchlevel.h' or die;
3ffabb8c GS	96	my @patchlevel_h = <PATCHLEVEL>;
3ffabb8c GS	97	close PATCHLEVEL;
d4257220	98	my $patchlevel_h = join "", grep { /^#\s*define/ } @patchlevel_h;
08aa1457	99	print $patchlevel_h;
93136620	100	$revision = $1 if $patchlevel_h =~ /PERL_REVISION\s+(\d+)/;
d4257220 GS	101	$patchlevel = $1 if $patchlevel_h =~ /PERL_VERSION\s+(\d+)/;
d4257220 GS	102	$subversion = $1 if $patchlevel_h =~ /PERL_SUBVERSION\s+(\d+)/;
55d729e4	103	die "Unable to parse patchlevel.h" unless $subversion >= 0;
93136620	104	$vers = sprintf("%d.%d.%d", $revision, $patchlevel, $subversion);
08aa1457	105
3ffabb8c GS	106	# fetch list of local patches
3ffabb8c GS	107	my (@local_patches, @lpatch_tags, $lpatch_tags);
699a100d RS	108	@local_patches = grep { !/^\s*,?NULL/ && ! /,"uncommitted-changes"/ }
	109	grep { /^static.*local_patches/../^};/ }
	110	@patchlevel_h;
3ffabb8c GS	111	@lpatch_tags = map { /^\s*,"(\w+)/ } @local_patches;
	112	$lpatch_tags = join "-", @lpatch_tags;
	113
2a7df08c	114	$perl = "perl-$vers";
f27ffc4a	115	$reldir = "$perl";
5f244db9 DM	116
5f244db9 DM	117	$lpatch_tags = $opts{s} if defined $opts{s};
3ffabb8c	118	$reldir .= "-$lpatch_tags" if $lpatch_tags;
08aa1457	119
f27ffc4a	120	print "\nMaking a release for $perl in $relroot/$reldir\n\n";
08aa1457	121
d2540b73 N	122	cleanup($relroot, $reldir) if $opts{c};
d2540b73 N	123
08aa1457	124	print "Cross-checking the MANIFEST...\n";
08aa1457	125	($missfile, $missentry) = fullcheck();
37d29c6f	126	@$missentry
41fd77f8	127	= grep {$_ !~ m!^\.(?:git\|github\|mailmap)! and $_ !~ m!(?:/\|^)\.gitignore!} @$missentry;
9b05e874 JV	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	}
90248788 TB	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	}
3e3baf6d	144	die "Aborted.\n" if @$missentry or @$missfile;
08aa1457	145	print "\n";
08aa1457	146
b59922b7	147	# VMS no longer has hardcoded version numbers descrip.mms
48e117bb GS	148
48e117bb GS	149	print "Creating $relroot/$reldir release directory...\n";
d2540b73 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";
48e117bb GS	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";
86cd7d77 JH	160	system($cmd) == 0
86cd7d77 JH	161	or die "$cmd failed";
48e117bb GS	162	print "\n";
48e117bb GS	163
6e24577b	164	chdir "$relroot/$reldir" or die $!;
48e117bb	165
5326e4da	166	my @exe = map { my ($f) = split; glob($f) }
ff906f87 DG	167	grep { $_ !~ /\A#/ && $_ !~ /\A\s*\z/ }
	168	map { split "\n" }
	169	do { local (@ARGV, $/) = 'Porting/exec-bit.txt'; <> };
	170
b38ce61e KW	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
86cd7d77 JH	274	system("chmod +x @exe") == 0
86cd7d77 JH	275	or die "system: $!";
6e24577b	276
b38ce61e	277	# MANIFEST may be resorted, so needs to be writable
f7f713ed	278	my @writables = qw(
f3513db0 JH	279	NetWare/config_H.wc
f3513db0 JH	280	NetWare/Makefile
f2c01b15	281	feature.h
11b27549	282	lib/feature.pm
ac634a9a	283	keywords.h
26ea9e12	284	keywords.c
b38ce61e	285	MANIFEST
ac634a9a JH	286	opcode.h
	287	opnames.h
	288	pp_proto.h
ac634a9a	289	proto.h
f7f713ed GS	290	embed.h
f7f713ed GS	291	embedvar.h
fa9ec1c9	292	overload.inc
e9e0c7d0	293	overload.h
8b09643d	294	mg_vtable.h
7baf245a KW	295	dist/Devel-PPPort/module2.c
7baf245a KW	296	dist/Devel-PPPort/module3.c
e120c24f	297	cpan/autodie/t/touch_me
e9e0c7d0 NC	298	reentr.c
	299	reentr.h
	300	regcharclass.h
f7f713ed	301	regnodes.h
0ebdc6d5	302	warnings.h
ac634a9a	303	lib/warnings.pm
e120c24f	304	win32/GNUmakefile
ac634a9a JH	305	win32/Makefile
ac634a9a JH	306	win32/makefile.mk
f29c64d6	307	win32/config_H.gc
f7f713ed	308	win32/config_H.vc
18b94d96	309	uconfig.h
f7f713ed	310	);
c9e35064 MH	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;
c9e35064	320	}
f7f713ed	321
976a2e28 MH	322	warn $out if $out;
976a2e28 MH	323
6e24577b GS	324	chdir ".." or die $!;
6e24577b GS	325
1baeb402 DG	326	exit if $opts{n};
1baeb402 DG	327
f27ffc4a	328	my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch
85bdf03b	329
b38ce61e KW	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	}
08aa1457	337
0dcf3caa LB	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
b38ce61e	342	if (! $opts{e} && $have_7z) {
0dcf3caa LB	343	print "Creating and compressing the tar.gz file with 7z...\n";
0dcf3caa LB	344	$cmd = "tar cf - $reldir \| 7z a -tgzip -mx9 -bd -si $reldir.tar.gz";
85bdf03b	345	system($cmd) == 0 or die "$cmd failed";
0dcf3caa LB	346	} else {
0dcf3caa LB	347	print "Creating and compressing the tar.gz file...\n";
b38ce61e KW	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";
0dcf3caa LB	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
f276fdad	362	if ($opts{x}) {
b38ca28d	363	print "Creating and compressing the tar.xz file with xz...\n";
f276fdad CBW	364	$cmd = "tar cf - $reldir \| xz -z -c > $reldir.tar.xz";
	365	system($cmd) == 0 or die "$cmd failed";
	366	}
	367
85bdf03b	368	print "\n";
9b05e874	369
ecc9c9d9 DM	370	system("ls -ld $perl*");
	371	print "\n";
	372
e8c01f92	373	my $null = $^O eq 'MSWin32' ? 'NUL' : '/dev/null';
ecc9c9d9	374	for my $sha (qw(sha1 shasum sha1sum)) {
e8c01f92	375	if (`which $sha 2>$null`) {
ecc9c9d9 DM	376	system("$sha $perl.tar.");
	377	last;
	378	}
9b05e874	379	}
d2540b73 N	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;