source: box/trunk/infrastructure/makedistribution.pl.in @ 2596

#!@PERL@

use strict;
use Symbol;

# comment string for various endings
my %comment_chars = ('cpp' => '// ', 'h' => '// ', 'pl' => '# ', 'pm' => '# ', '' => '# ');

# other extensions which need text copying, just to remove the private stuff
# .in is included here, as these could be any kind of source, but clearly
# they have text substitutions run on them by autoconf, so we can too :)
my %text_files = ('txt' => 1, 'spec' => 1, 'in' => 1);

# files which don't get the license added
# my %file_license = (); # 'filename' => 'GPL', 'DUAL' or 'none'

# ----------------------------------------------

# filled in from the manifest file
# my %dir_license = (); # 'dir' => 'GPL', 'DUAL' or 'none'
#
# most recently specified LICENSE become default until overridden
my $current_license; # 'GPL', 'DUAL' or 'none'

# distribution name
my $distribution = $ARGV[0];
die "No distribution name specified on the command line" if $distribution eq '';
my $dist_root = "distribution/$distribution";

# check distribution exists
die "Distribution '$distribution' does not exist" unless -d $dist_root;

# get version
open VERSION,"$dist_root/VERSION.txt" or die "Can't open $dist_root/VERSION.txt";
my $version = <VERSION>;
chomp $version;
my $archive_name = <VERSION>;
chomp $archive_name;
close VERSION;

# consistency check
die "Archive name '$archive_name' is not equal to the distribution name '$distribution'"
        unless $archive_name eq $distribution;

my $svnversion = `svnversion .`;
chomp $svnversion;
$svnversion =~ tr/0-9A-Za-z/_/c;

if($version =~ /USE_SVN_VERSION/)
{
        # for developers, use SVN version
        open INFO,'svn info . |';
        my $svnurl;
        while(<INFO>)
        {
                if(m/^URL: (.+?)[\n\r]+/)
                {
                        $svnurl = $1;
                }
        }
        close INFO;
        $svnurl =~ m'box/(.+)$';
        my $svndir = $1;
        $svndir =~ tr/0-9A-Za-z/_/c;
        $version =~ s/USE_SVN_VERSION/$svndir.'_'.$svnversion/e;
}

# make initial directory
my $base_name = "$archive_name-$version";
system "rm -rf $base_name";
system "rm $base_name.tgz";
mkdir $base_name,0755;

# get license files
my %license_text; # name of license => array of lines of license text
foreach my $license ("GPL", "DUAL")
{
        my $file = "./LICENSE-$license.txt";
        open LICENSE, $file or die "Can't open $file: $!";
        my @lines = <LICENSE>;
        close LICENSE;
        unshift @lines, "distribution $base_name (svn version: $svnversion)\n";
        $license_text{$license} = \@lines;
}

# copy files, make a note of all the modules included
my %modules_included;
my $private_sections_removed = 0;
my $non_distribution_sections_removed = 0;
sub copy_from_list
{
        my $list = $_[0];
        open LIST,$list or die "Can't open $list";
        
        while(my $line = <LIST>)
        {
                next unless $line =~ m/\S/;
                chomp $line;
                my @words = split /\s+/, $line;
                my ($src,$dst,$other) = @words;
                $dst = $src if $dst eq '';
                if($src eq 'MKDIR')
                {
                        # actually we just need to make a directory here
                        mkdir "$base_name/$dst",0755;
                }
                elsif($src eq 'LICENSE')
                {
                        $current_license = $dst;
                }
                elsif($src eq 'REPLACE-VERSION-IN')
                {
                        replace_version_in($dst);
                }
                elsif($src eq 'RUN')
                {
                        my ($junk,$cmd) = split /\s+/, $line, 2;
                        print "Running $cmd...\n";
                        if(system($cmd) != 0)
                        {
                                print "Error running $cmd. Aborting.\n";
                                exit(1);
                        }
                }
                elsif(-d $src)
                {
                        $modules_included{$line} = 1;
                        copy_dir($src,$dst);
                }
                else
                {
                        copy_file($src,$dst);
                }
        }
        
        close LIST;
}
copy_from_list("distribution/COMMON-MANIFEST.txt");
copy_from_list("$dist_root/DISTRIBUTION-MANIFEST.txt");

# Copy in the root directory and delete the DISTRIBUTION-MANIFEST file
(system("cp $dist_root/*.* $base_name/") == 0)
        or die "Copy of root extra files failed";
unlink "$base_name/DISTRIBUTION-MANIFEST.txt"
        or die "Delete of DISTRIBUTION-MANIFEST.txt file failed";
replace_version_in("VERSION.txt");

# produce a new modules file
my $modules = gensym;
open $modules,"modules.txt" or die "Can't open modules.txt for reading";
open MODULES_OUT,">$base_name/modules.txt";

while(<$modules>)
{
        # skip lines for modules which aren't included
        next if m/\A(\w+\/\w+)\s/ && !exists $modules_included{$1};
        
        # skip private sections
        unless(skip_non_applicable_section($_, $modules, 'modules.txt'))
        {
                # copy line to out files
                print MODULES_OUT
        }
}

close MODULES_OUT;
close $modules;

# report on how many private sections were removed
print "Private sections removed: $private_sections_removed\nNon-distribution sections removed: $non_distribution_sections_removed\n";

# tar it up
system "tar cf - $base_name | gzip -9 - > $base_name.tgz";

sub copy_file
{
        my ($fn,$dst_fn) = @_;
        
        my $ext;
        $ext = $1 if $fn =~ m/\.(\w+)\Z/;
        $dst_fn =~ m~\A(.+)/[^/]+?\Z~;
        
        # licensed or not?
        if(exists $comment_chars{$ext} && $current_license ne "none")
        {
                # copy as text, inserting license
                # print "source copy $fn to $base_name/$dst_fn\n";

                my $in = gensym;
                open $in,$fn or die "$fn: $!";
                open OUT,">$base_name/$dst_fn" or die "$base_name/$dst_fn: $!";
                
                my $first = <$in>;
                if($first =~ m/\A#!/)
                {
                        print OUT $first;
                        $first = '';
                }
                
                # write license
                my $b = $comment_chars{$ext};
                my $this_license = $license_text{$current_license};
                for (@$this_license)
                {
                        print OUT $b, $_;
                }
                
                if($first ne '')
                {
                        print OUT $first;
                }
                
                while(<$in>)
                {
                        unless(skip_non_applicable_section($_, $in, $fn))
                        {
                                print OUT
                        }
                }       
                
                close OUT;
                close $in;
        }
        elsif(exists $text_files{$ext})
        {
                # copy this as text, to remove private stuff
                # print "text copy $fn to $base_name/$dst_fn\n";

                my $in = gensym;
                open $in,$fn or die "$fn: $!";
                open OUT,">$base_name/$dst_fn" or die "$base_name/$dst_fn: $!";

                while(<$in>)
                {
                        unless(skip_non_applicable_section($_, $in, $fn))
                        {
                                print OUT
                        }
                }       

                close OUT;
                close $in;
        }
        else
        {
                # copy as binary
                # print "binary copy $fn to $base_name/$dst_fn\n";
                my $cmd = "cp -p $fn $base_name/$dst_fn";
                system($cmd) == 0 or die "copy failed: $cmd";
        }
        
        # copy executable bit from src
        if(-x $fn)
        {
                system 'chmod','a+x',"$base_name/$dst_fn"
        }
        else
        {
                system 'chmod','a-x',"$base_name/$dst_fn"
        }
}

sub skip_non_applicable_section
{
        my ($l, $filehandle, $filename) = @_;
        if($l =~ m/BOX_PRIVATE_BEGIN/)
        {
                # skip private section
                print "Removing private section from $filename\n";
                $private_sections_removed++;
                while(<$filehandle>) {last if m/BOX_PRIVATE_END/}
                
                # skipped something
                return 1;
        }
        elsif($l =~ m/IF_DISTRIBUTION\((.+?)\)/)
        {
                # which distributions does this apply to?
                my $applies = 0;
                for(split /,/,$1)
                {
                        $applies = 1 if $_ eq $distribution
                }
                unless($applies)
                {
                        # skip section?
                        print "Removing distribution specific section from $filename\n";
                        $non_distribution_sections_removed++;
                        while(<$filehandle>) {last if m/END_IF_DISTRIBUTION/}
                }
                # hide this line
                return 1;
        }
        elsif($l =~ m/END_IF_DISTRIBUTION/)
        {
                # hide these lines
                return 1;
        }
        else
        {
                # no skipping, return this line
                return 0;
        }
}

sub copy_dir
{
        my ($dir,$dst_dir) = @_;

        # copy an entire directory... first make sure it exists
        my @n = split /\//,$dst_dir;
        my $d = $base_name;
        for(@n)
        {
                $d .= '/';
                $d .= $_;
                mkdir $d,0755;
        }
        
        # then do each of the files within in
        opendir DIR,$dir;
        my @items = readdir DIR;
        closedir DIR;
        
        for(@items)
        {
                next if m/\A\./;
                next if m/\A_/;
                next if m/\AMakefile\Z/;
                next if m/\Aautogen/;
                next if m/-smf-method\Z/; # copy only the .in versions
                next if m/-manifest.xml\Z/; # copy only the .in versions
                if($dir eq 'docs') {
                        next if m/.(x[sm]l|tmpl)\Z/; # don't include doc sources
                        next if m/generate_except_xml.pl/;
                }
                next if !-f "$dir/$_";
                
                copy_file("$dir/$_","$dst_dir/$_");
        }
}

sub replace_version_in
{
        my ($file) = @_;
        
        my $fn = $base_name . '/' . $file;
        open IN,$fn or die "Can't open $fn";
        open OUT,'>'.$fn.'.new' or die "Can't open $fn.new for writing";
        
        while(<IN>)
        {
                s/###DISTRIBUTION-VERSION-NUMBER###/$version/g;
                s/.*USE_SVN_VERSION.*/$version/g;
                print OUT
        }
        
        close OUT;
        close IN;

        rename($fn.'.new', $fn) or die "Can't rename in place $fn";
}