From c012d8b882480151d8eb7da92c4cca80d1d9b814 Mon Sep 17 00:00:00 2001
From: pmichaud <pmichaud@pobox.com>
Date: Tue, 28 Aug 2012 00:36:53 -0500
Subject: Move skel/ into top-level directory, to try building directly from
 the repo.

---
 tools/build/module-install.pl | 112 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 112 insertions(+)
 create mode 100644 tools/build/module-install.pl

(limited to 'tools/build/module-install.pl')

diff --git a/tools/build/module-install.pl b/tools/build/module-install.pl
new file mode 100644
index 0000000..8d69c78
--- /dev/null
+++ b/tools/build/module-install.pl
@@ -0,0 +1,112 @@
+#! perl
+
+use warnings;
+use strict;
+use File::Find;
+use File::Copy;
+use File::Path;
+use File::Basename;
+
+my $perl6bin = shift @ARGV;
+my $perl6lib = shift @ARGV;
+
+my @pmfiles;
+my @mod_pms;
+while (@ARGV) {
+    my $module = shift @ARGV;
+    print "== Installing module $module\n";
+    our $mlib  = "$module/lib";
+    
+    @mod_pms = ();
+    find({ no_chdir=>1, wanted => \&libcopy }, $mlib);
+
+    sub libcopy {
+        return unless /\.pm6?|\.pod/;
+        my $source = $File::Find::name;
+        my $target = $source;
+        $target =~ s/\Q$mlib\E/$perl6lib/;
+        print "$source => $target\n";
+        mkpath dirname($target);
+        copy($source, $target) or die "copy failed: $!\n";
+        push @mod_pms, $target if $target =~ /\.pm6?/;
+    }
+    
+    my %usages_of;
+    my @modules;
+    my %module_to_path;
+    for my $module_file (@mod_pms) {
+        open(my $fh, '<', $module_file) or die $!;
+        my $module = path_to_module_name($module_file);
+        push @modules, $module;
+        $module_to_path{$module} = $module_file;
+        $usages_of{$module} = [];
+        while (<$fh>) {
+            if (/^\s* (?:use|need) \s+ (\w+ (?: :: \w+)*)/x and my $used = $1) {
+                next if $used eq 'v6';
+                next if $used eq 'MONKEY_TYPING';
+
+                push @{$usages_of{$module}}, $used;
+            }
+        }
+    }
+    
+    my @order = topo_sort(\@modules, \%usages_of);
+    my @sources = map { $module_to_path{$_} } @order;
+    push @pmfiles, @sources;
+}
+
+# Internally, we treat the module names as module names, '::' and all.
+# But since they're really files externally, they have to be converted
+# from paths to module names, and back again.
+
+sub path_to_module_name {
+    $_ = shift;
+    s/^.+\blib\///;
+    s/^.+\blib6\///;
+    s/\.pm6?$//;
+    s/\//::/g;
+    $_;
+}
+
+chdir 'rakudo';
+foreach my $pm (@pmfiles) {
+    my $out = $pm; 
+    $out =~ s/\.pm6?$/.pir/;
+    my @cmd = ($perl6bin, '--target=pir', "--output=$out", $pm);
+    print join(' ', @cmd), "\n";
+    system(@cmd);
+}
+
+
+# According to "Introduction to Algorithms" by Cormen et al., topological
+# sort is just a depth-first search of a graph where you pay attention to
+# the order in which you get done with a dfs-visit() for each node.
+
+sub topo_sort {
+    my ($modules, $dependencies) = @_;
+    my @modules = @$modules;
+    my @order;
+    my %color_of = map { $_ => 'not yet visited' } @modules;
+
+    for my $module (@modules) {
+        if ($color_of{$module} eq 'not yet visited') {
+            dfs_visit($module, \%color_of, $dependencies, \@order);
+        }
+    }
+    return @order;
+}
+
+sub dfs_visit {
+    my $module = shift;
+    my $color_of = shift;
+    my $dependencies = shift;
+    my $order = shift;
+    $color_of->{$module} = 'visited';
+    for my $used (@{$dependencies->{$module}}) {
+        $color_of->{$used} ||= '';
+        if ($color_of->{$used} eq 'not yet visited') {
+            dfs_visit($used, $color_of, $dependencies, $order);
+        }
+    }
+    push @$order, $module;
+}
-- 
cgit v1.1