Copy NQP::Configure library from nqp repo.

1 files changed, 354 insertions, 0 deletions

diff --git a/skel/tools/lib/NQP/Configure.pm b/skel/tools/lib/NQP/Configure.pm
new file mode 100644
index 0000000..0572a62
--- /dev/null
+++ b/skel/tools/lib/NQP/Configure.pm
@@ -0,0 +1,354 @@
+package NQP::Configure;
+use strict;
+use warnings;
+use Cwd;
+
+use base qw(Exporter);
+our @EXPORT_OK = qw(sorry slurp system_or_die
+                    cmp_rev 
+                    read_parrot_config read_config
+                    fill_template_file fill_template_text 
+                    git_checkout
+                    verify_install
+                    gen_nqp gen_parrot);
+
+our $exe = $^O eq 'MSWin32' ? '.exe' : '';
+
+our @required_parrot_files = qw(
+    @bindir@/parrot@exe@
+    @bindir@/pbc_to_exe@exe@
+    @bindir@/ops2c@exe@
+    @libdir@@versiondir@/tools/build/pmc2c.pl
+    @srcdir@@versiondir@/pmc
+    @includedir@@versiondir@/pmc
+);
+
+our @required_nqp_files = qw(
+    @bindir@/nqp@exe@
+);
+
+our $nqp_git = 'git://github.com/perl6/nqp.git';
+our $par_git = 'git://github.com/parrot/parrot.git';
+
+sub sorry {
+    my @msg = @_;
+    die join("\n", '', '===SORRY!===', @msg, "\n");
+}
+
+sub slurp {
+    my $filename = shift;
+    open my $fh, '<', $filename
+        or die "Unable to read $filename\n";
+    local $/ = undef;
+    my $text = <$fh>;
+    close $fh or die $!;
+    return $text;
+}
+
+
+sub system_or_die {
+    my @cmd = @_;
+    system( @cmd ) == 0
+        or die "Command failed (status $?): @cmd\n";
+}
+
+
+sub parse_revision {
+    my $rev = shift;
+    my $sep = qr/[_.]/;
+    $rev =~ /(\d+)$sep(\d+)(?:$sep(\d+))?(?:-(\d+)-g[a-f0-9]*)?$/
+        or die "Unrecognized revision specifier '$rev'\n";
+    return ($1, $2, $3 || 0, $4 || 0);
+}
+
+
+sub cmp_rev {
+    my ($a, $b) = @_;
+    my @a = parse_revision($a);
+    my @b = parse_revision($b);
+    my $cmp = 0;
+    for (0..3) {
+        $cmp = $a[$_] <=> $b[$_];
+        last if $cmp;
+    }
+    $cmp;
+}
+
+
+sub read_config {
+    my @config_src = @_;
+    my %config = ();
+    for my $file (@config_src) {
+        no warnings;
+        if (open my $CONFIG, '-|', "$file --show-config") {
+            while (<$CONFIG>) {
+                if (/^([\w:]+)=(.*)/) { $config{$1} = $2 }
+            }
+            close($CONFIG);
+        }
+        last if %config;
+    }
+    return %config;
+}
+
+
+sub read_parrot_config {
+    my @parrot_config_src = @_;
+    my %config = ();
+    open my $CONFIG_PIR, '>', 'parrot-config.pir'
+      or die "Unable to write parrot-config.pir\n";
+    print $CONFIG_PIR <<'END';
+        .include 'iglobals.pasm'
+        .sub "main" :main
+            .local pmc interp, config_hash, config_iter
+            interp = getinterp
+            config_hash = interp[.IGLOBALS_CONFIG_HASH]
+            config_iter = iter config_hash
+          config_loop:
+            unless config_iter goto config_done
+            $P0 = shift config_iter
+            print "parrot::"
+            $S0 = $P0.'key'()
+            print $S0
+            print "="
+            $S0 = $P0.'value'()
+            print $S0
+            print "\n"
+            goto config_loop
+          config_done:
+            .return ()
+        .end
+END
+    close($CONFIG_PIR);
+    
+    for my $file (@parrot_config_src) {
+        no warnings;
+        if ($file =~ /.pir$/ && open my $PARROT_CONFIG, '<', $file) {
+            while (<$PARROT_CONFIG>) {
+                if (/P0\["(.*?)"\], "(.*?)"/) { $config{"parrot::$1"} = $2 }
+            }
+            close($PARROT_CONFIG) or die $!;
+        }
+        elsif (open my $PARROT, '-|', "$file parrot-config.pir") {
+            while (<$PARROT>) {
+                if (/^([\w:]+)=(.*)/) { $config{$1} = $2 }
+            }
+            close($PARROT);
+        }
+        last if %config;
+    }
+    unlink('parrot-config.pir');
+    return %config;
+}
+
+
+sub fill_template_file {
+    my $infile = shift;
+    my $outfile = shift;
+    my %config = @_;
+    my $text = slurp( $infile );
+    $text = fill_template_text($text, %config);
+    print "\nCreating $outfile ...\n";
+    open(my $OUT, '>', $outfile)
+        or die "Unable to write $outfile\n";
+    print $OUT $text;
+    close($OUT) or die $!;
+}
+
+
+sub fill_template_text {
+    my $text = shift;
+    my %config = @_;
+
+    $text =~ s/@([:\w]+)@/$config{$1} || $config{"parrot::$1"} || ''/ge;
+    if ($text =~ /nqp::makefile/) {
+        if ($^O eq 'MSWin32') {
+            $text =~ s{/}{\\}g;
+            $text =~ s{\\\*}{\\\\*}g;
+            $text =~ s{(?:git|http):\S+}{ do {my $t = $&; $t =~ s'\\'/'g; $t} }eg;
+            $text =~ s/.*curl.*/do {my $t = $&; $t =~ s'%'%%'g; $t}/meg;
+        }
+        if ($config{'makefile-timing'}) {
+            $text =~ s{ (?<!\\\n)        # not after line ending in '\'
+                        ^                # beginning of line
+                        (\t(?>@?[ \t]*)) # capture tab, optional @, and hspace
+                        (?!-)            # not before - (ignore error) lines
+                        (?!cd)           # not before cd lines
+                        (?!echo)         # not before echo lines
+                        (?=\S)           # must be before non-blank
+                      }
+                      {$1time\ }mgx;
+        }
+    }
+    $text;
+}
+
+
+sub git_checkout {
+    my $repo = shift;
+    my $dir  = shift;
+    my $checkout = shift;
+    my $pwd = cwd();
+
+    # get an up-to-date repository
+    if (! -d $dir) {
+        system_or_die('git', 'clone', $repo, $dir);
+        chdir($dir);
+    }
+    else {
+        chdir($dir);
+        system_or_die('git', 'fetch');
+    }
+
+    if ($checkout) {
+        system_or_die('git', 'checkout', $checkout);
+        system_or_die('git', 'pull') 
+            if slurp('.git/HEAD') =~ /^ref:/;
+    }
+
+    my $git_describe;
+    if (open(my $GIT, '-|', "git describe --tags")) {
+        $git_describe = <$GIT>;
+        close($GIT);
+        chomp $git_describe;
+    }
+    chdir($pwd);
+    $git_describe;
+}
+
+
+sub verify_install {
+    my $files = shift;
+    my %config = @_;
+    print "Verifying installation ...\n";
+    my @missing;
+    for my $reqfile ( @{$files} ) {
+        my $f = fill_template_text($reqfile, %config);
+        push @missing, "    $f" unless -e $f;
+    }
+    if (@missing) {
+        unshift @missing, "I'm missing some needed files:";
+    }
+    @missing;
+}
+
+
+sub gen_nqp {
+    my $nqp_want = shift;
+    my %options  = @_;
+
+    my $gen_nqp     = $options{'gen-nqp'};
+    my $with_parrot = $options{'with-parrot'};
+    my $gen_parrot  = $options{'gen-parrot'};
+    my $prefix      = $options{'prefix'} || cwd().'/install';
+    my $startdir    = cwd();
+
+    my $PARROT_REVISION = 'nqp/tools/build/PARROT_REVISION';
+
+    my %config;
+    my $nqp_exe;
+    if ($with_parrot) {
+        %config = read_parrot_config($with_parrot)
+            or die "Unable to read parrot configuration from $with_parrot\n";
+        $prefix  = $config{'parrot::prefix'};
+        $nqp_exe = fill_template_text('@bindir@/nqp@ext@', %config);
+        %config = read_config($nqp_exe);
+    }
+    elsif ($prefix) {
+        $nqp_exe = "$prefix/bin/nqp$exe";
+        %config = read_config($nqp_exe);
+    }
+
+    my $nqp_have = $config{'nqp::version'} || '';
+    my $nqp_ok   = $nqp_have && cmp_rev($nqp_have, $nqp_want) >= 0;
+    if ($gen_nqp) {
+        my $nqp_repo = git_checkout($nqp_git, 'nqp', $gen_nqp);
+        $nqp_ok = $nqp_have eq $nqp_repo;
+    }
+    elsif (!$nqp_ok || defined $gen_parrot && !-f $PARROT_REVISION) {
+        git_checkout($nqp_git, 'nqp', $nqp_want);
+    }
+
+    if (defined $gen_parrot) {
+        my ($par_want) = split(' ', slurp($PARROT_REVISION));
+        $with_parrot = gen_parrot($par_want, %options, prefix => $prefix);
+        %config = read_parrot_config($with_parrot);
+    }
+    elsif (!%config) {
+        %config = read_parrot_config("$prefix/bin/parrot$exe", "parrot$exe");
+        $with_parrot = fill_template_text('@bindir@/parrot@exe@', %config);
+    }
+
+    if ($nqp_ok && -M $nqp_exe < -M $with_parrot) {
+        print "$nqp_exe is NQP $nqp_have.\n";
+        return $nqp_exe;
+    }
+
+    my @cmd = ($^X, 'Configure.pl', "--with-parrot=$with_parrot",
+               "--make-install");
+    print "Building NQP ...\n";
+    chdir("$startdir/nqp");
+    print "@cmd\n";
+    system_or_die(@cmd);
+    chdir($startdir);
+    return fill_template_text('@bindir@/nqp@exe@', %config);
+}
+
+
+sub gen_parrot {
+    my $par_want = shift;
+    my %options  = @_;
+
+    my $prefix     = $options{'prefix'} || cwd()."/install";
+    my $gen_parrot = $options{'gen-parrot'};
+    my @opts       = @{ $options{'parrot-option'} || [] };
+    push @opts, "--optimize";
+    my $startdir   = cwd();
+
+    my $par_exe  = "$options{'prefix'}/bin/parrot$exe";
+    my %config   = read_parrot_config($par_exe);
+
+    my $par_have = $config{'parrot::git_describe'} || '';
+    my $par_ok   = $par_have && cmp_rev($par_have, $par_want) >= 0;
+    if ($gen_parrot) {
+        my $par_repo = git_checkout($par_git, 'parrot', $gen_parrot);
+        $par_ok = $par_have eq $par_repo;
+    }
+    elsif (!$par_ok) {
+        git_checkout($par_git, 'parrot', $par_want);
+    }
+
+    if ($par_ok) {
+        print "$par_exe is Parrot $par_have.\n";
+        return $par_exe;
+    }
+    chdir("$startdir/parrot") or die $!;
+    if (-f 'Makefile') {
+        %config = read_parrot_config('config_lib.pir');
+        my $make = $config{'parrot::make'};
+        if ($make) {
+            print "\nPerforming '$make realclean' ...\n";
+            system_or_die($make, 'realclean');
+        }
+    }
+
+    $prefix =~ s{\\}{/}g;
+
+    print "\nConfiguring Parrot ...\n";
+    my @cmd = ($^X, "Configure.pl", @opts, "--prefix=$prefix");
+    print "@cmd\n";
+    system_or_die(@cmd);
+
+    print "\nBuilding Parrot ...\n";
+    %config = read_parrot_config('config_lib.pir');
+    my $make = $config{'parrot::make'} or
+        die "Unable to determine value for 'make' from parrot config\n";
+    system_or_die($make, 'install-dev');
+    chdir($startdir);
+
+    print "Parrot installed.\n";
+    return fill_template_text('@bindir@/parrot@exe@', %config);
+}
+
+
+1;