Some roles ported to module-tools

masak · Nov 13, 2010 · 09bf501 · 09bf501
1 parent f7bb51b
commit 09bf501
Showing 1 changed file with 14 additions and 109 deletions.
diff --git a/proof-of-concept b/proof-of-concept
@@ -3,6 +3,8 @@ use v6;
 
 use App::Pls;
 use JSON::Tiny;
+use Module::Build;
+use Module::Test;
 
 role FileBackend {
     has $.filename;
@@ -139,125 +141,28 @@ sub find-files($in-dir, $pattern) {
 class POC::Builder does App::Pls::Builder {
     method build($project --> Result) {
         my $target-dir = "cache/$project<name>";
-        if $*VM<config><osname> ne 'MSWin32'
-           && "$target-dir/Makefile".IO ~~ :e {
-            # Already has Makefile and not running Windows -- use the Makefile
-            unless run-logged( relative-to($target-dir, 'make'),
-                               :step('build'), :$project ) {
-                return failure;
+        my $ret = success;
+        try {
+        Module::Build::build($target-dir);
+            CATCH {
+                $ret = failure;
             }
         }
-        else {
-            # No Makefile or on Windows -- roll our own `make` process
-            my $binary = 'perl6';
-
-            # Locate Perl 6 module files.
-
-            my @module-files = find-files("$target-dir/lib", /\.pm6?$/);
-            @module-files>>.=subst("$target-dir/", "");
-
-            # To know the best order of compilation, we build a dependency
-            # graph of all the modules in lib/. %usages_of ends up containing
-            # a graph, with the keys (containing names modules) being nodes,
-            # and the values (containing arrays of names) denoting directed
-            # edges.
-
-            my @modules = map { path-to-module-name($_) }, @module-files;
-            my %usages_of;
-            for @module-files -> $module-file {
-                my $fh;
-                my $succeeded = False;
-                try {
-                    $fh = open($target-dir ~ '/' ~ $module-file, :r);
-                    $succeeded = True;
-                }
-                unless $succeeded {
-                    return failure;
-                }
-                my $module = path-to-module-name($module-file);
-                %usages_of{$module} = [];
-                for $fh.lines() {
-                    if /^\s* 'use' \s+ (\w+ ['::' \w+]*)/ && $0 -> $used {
-                        next if $used eq 'v6';
-                        next if $used eq 'MONKEY_TYPING';
-
-                        %usages_of{$module}.push(~$used);
-                    }
-                }
-            }
-
-            sub path-to-module-name($path) {
-                $path.subst(/^'lib/'/, '').subst(/\.pm6?$/, '')\
-                     .subst('/', '::', :g);
-            }
-
-            sub module-name-to-path($module-name, $base-path = '') {
-                my $pm = 'lib/' ~ $module-name.subst('::', '/', :g) ~ '.pm';
-                ($base-path ~ ($base-path ?? '/' !! '') ~ $pm).IO ~~ :e
-                    ?? $pm !! $pm ~ '6';
-            }
-
-            my @order;
-
-            # 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 the
-            # dfs-visit() for each node.
-
-            my %color_of = @modules X=> 'not yet visited';
-            for @modules -> $module {
-                if %color_of{$module} eq 'not yet visited' {
-                    dfs-visit($module);
-                }
-            }
-
-            sub dfs-visit($module) {
-                %color_of{$module} = 'visited';
-                for %usages_of{$module}.list -> $used {
-                    if %color_of{$used} eq 'not yet visited' {
-                        dfs-visit($used);
-                    }
-                }
-                push @order, $module;
-            }
-
-            for @order>>.&module-name-to-path($target-dir) -> $module {
-                my $command = "PERL6LIB=$target-dir/lib $binary "
-                               ~ "--target=PIR --output={
-                               $module.subst(/\.pm6?/, ".pir")} $module";
-                unless run-logged( relative-to($target-dir, $command),
-                                   :step('build'), :$project ) {
-                    return failure;
-                }
-            }
-        }
-
-        return success;
+        return $ret;
     }
 }
 
 class POC::Tester does App::Pls::Tester {
     method test($project --> Result) {
         my $target-dir = "cache/$project<name>";
-        if $*VM<config><osname> ne 'MSWin32'
-           && "$target-dir/Makefile".IO ~~ :e {
-            unless run-logged( relative-to($target-dir, "make test"),
-                               :step('test'), :$project ) {
-                return failure;
-            }
-        }
-        else {
-            if "$target-dir/t".IO !~~ :e {
-                return success;
-            }
-            my $command = "env PERL6LIB=`pwd`/lib prove -e 'perl6' -r t/";
-            unless run-logged( relative-to($target-dir, $command),
-                               :step('build'), :$project ) {
-                return failure;
+        my $ret = success;
+        try {
+            Module::Test::test($target-dir);
+            CATCH {
+                $ret = failure;
             }
         }
-
-        return success;
+        return $ret;
     }
 }