Permalink
Browse files

De-suckyfying: no more travelling across directories all around. Big …

…changes, please test
  • Loading branch information...
1 parent da2ff27 commit 7137209be59f8c150969c2e55bc2fa86d2355602 @tadzik committed Dec 24, 2010
Showing with 72 additions and 58 deletions.
  1. +47 −37 bin/neutro
  2. +7 −6 tmplib/Module/Build.pm
  3. +14 −14 tmplib/Module/Install.pm
  4. +4 −1 tmplib/Module/Test.pm
View
@@ -14,6 +14,13 @@ my $INSTALLED = "$CONFIGDIR/installed";
my $SRCDIR = "$CONFIGDIR/src";
my %modules;
+sub indir (Str $where, Callable $what) {
+ my $old = cwd;
+ mkdir $where, :p;
+ chdir $where;
+ $what();
+ chdir $old;
+}
# check if modules list is present, update it otherwise
sub checklist {
unless $CONFIGDIR.IO ~~ :d {
@@ -41,57 +48,61 @@ sub crap (Str $msg) {
sub fetch (Str $name, Str $url) {
my $res;
- mkdir $SRCDIR, :p;
- chdir $SRCDIR;
- notice "Fetching $name";
- if "$SRCDIR/$name".IO ~~ :d {
- chdir $name;
- $res = run 'git pull -q';
- crap "Failed updating the $name repo" if $res;
- } else {
- $res = run "git clone -q $url $name";
- crap "Failed cloning the $name repo" if $res;
- chdir $name;
- }
+ indir $SRCDIR, {
+ notice "Fetching $name";
+ if "$SRCDIR/$name".IO ~~ :d {
+ indir $name, {
+ $res = run 'git pull -q';
+ crap "Failed updating the $name repo" if $res;
+ };
+ } else {
+ $res = run "git clone -q $url $name";
+ crap "Failed cloning the $name repo" if $res;
+ }
+ };
}
-sub install (Str $module, Bool $strict?, Bool $v?, Bool :$fetch = True) {
+sub install (Str $module, Bool $strict, Bool $v, Bool :$fetch = True) {
my $res;
if $fetch {
%modules.exists($module) or crap "Unknown module $module";
fetch $module, %modules{$module};
}
- installdeps $module;
+ installdeps $module, $strict, $v;
+
notice "Building $module";
my $fail = False;
try {
- Module::Build::build :$v;
+ Module::Build::build :dir("$SRCDIR/$module"), :$v;
CATCH {
$fail = True;
}
}
crap "Building $module failed" if $fail;
+
# THINKABOUT: what if tests are someplace else?
# Everyone's allowed to do it
if $strict and 't'.IO !~~ :d {
crap "No tests for $module";
}
notice "Testing $module";
try {
- Module::Test::test :$v;
+ Module::Test::test "$SRCDIR/$module", :$v;
CATCH {
$fail = True;
}
}
crap "Tests failed for $module" if $fail;
+
notice "Installing $module";
try {
- Module::Install::install :$v;
+ Module::Install::install "$SRCDIR/$module", :$v;
CATCH {
$fail = True;
}
}
crap "Installing $module failed" if $fail;
+
notice "Successfully installed $module";
unless isinstalled $module {
@@ -102,21 +113,21 @@ sub install (Str $module, Bool $strict?, Bool $v?, Bool :$fetch = True) {
}
}
-sub installdeps (Str $name) {
- my $dir = cwd;
- if 'deps.proto'.IO ~~ :f {
- my $fh = open 'deps.proto';
- for $fh.lines -> $dep {
- next if $dep ~~ /^\#/;
- next if $dep eq '';
- unless isinstalled $dep {
- notice "$name depends on $dep, installing now";
- install $dep;
+sub installdeps (Str $name, $strict, $v) {
+ indir "$SRCDIR/$name", {
+ if 'deps.proto'.IO ~~ :f {
+ my $fh = open 'deps.proto';
+ for $fh.lines -> $dep {
+ next if $dep ~~ /^\#/;
+ next if $dep eq '';
+ unless isinstalled $dep {
+ notice "verbose" if $v;
+ install $dep, $strict, $v;
+ }
}
+ $fh.close;
}
- $fh.close;
- }
- chdir $dir;
+ };
}
sub isinstalled (Str $module) {
@@ -138,12 +149,11 @@ sub notice (Str $what) {
sub updatedb {
notice 'Updating modules database';
- my $cwd = cwd;
- chdir $CONFIGDIR;
- unlink 'projects.list' if 'projects.list'.IO ~~ :e;
- fetch 'ecosystem', 'git://github.com/perl6/ecosystem.git';
- cp 'projects.list', "$CONFIGDIR/projects.list";
- chdir $cwd;
+ indir $CONFIGDIR, {
+ unlink 'projects.list' if 'projects.list'.IO ~~ :e;
+ fetch 'ecosystem', 'git://github.com/perl6/ecosystem.git';
+ cp "$SRCDIR/ecosystem/projects.list", "$CONFIGDIR/projects.list";
+ };
}
multi MAIN ('list') {
@@ -155,7 +165,7 @@ multi MAIN ('update') {
updatedb;
}
-multi MAIN ($module, Bool :$strict, Bool :$v) {
+multi MAIN ($module, Bool :$strict, Bool :$v = False) {
checklist;
install $module, $strict, $v, :fetch($module eq '.' ?? False !! True);
}
View
@@ -3,15 +3,15 @@ use File::Find;
module Module::Build;
sub path-to-module-name($path) {
- $path.subst(/^'lib/'/, '').subst(/\.pm6?$/, '').subst('/', '::', :g)
+ $path.subst(/^.*'lib/'/, '').subst(/\.pm6?$/, '').subst('/', '::', :g)
}
-sub module-name-to-path($module-name) {
- my $pm = 'lib/' ~ $module-name.subst('::', '/', :g) ~ '.pm';
+sub module_name_to_path($base, $module-name) {
+ my $pm = "$base/lib/" ~ $module-name.subst('::', '/', :g) ~ '.pm';
$pm.IO ~~ :e ?? $pm !! $pm ~ '6';
}
-our sub build(Str $dir = '.', Str $binary = 'perl6', :$v) {
+our sub build(Str :$dir = '.', Str :$binary = 'perl6', Bool :$v) {
if "$dir/Configure.pl".IO ~~ :f {
my $cwd = cwd;
chdir $dir;
@@ -81,12 +81,13 @@ our sub build(Str $dir = '.', Str $binary = 'perl6', :$v) {
push @order, $module;
}
- for @order».&module-name-to-path -> $module {
+ my @opath = @order.map: { module_name_to_path($dir, $_) };
+ for @opath -> $module {
my $pir = $module.subst(/\.pm6?/, ".pir");
next if ($pir.IO ~~ :f &&
$pir.IO.stat.modifytime > $module.IO.stat.modifytime);
my $command = "PERL6LIB=$dir/lib $binary --target=PIR --output=$pir $module";
- say $command if $v.defined;
+ say $command if $v;
run $command and die "Failed building $module"
}
}
View
@@ -1,8 +1,13 @@
+module Module::Install;
+
#use File::Copy;
use File::Find;
-use File::Mkdir;
-
-module Module::Install;
+#use File::Mkdir; TODO: For some reason this does not work.
+sub mkdirp($name as Str) {
+ for [\~] $name.split('/').map({"$_/"}) {
+ mkdir($_) unless .IO.d
+ }
+}
our sub install(Str $dir = '.', Str $dest = "%*ENV<HOME>/.perl6/", :$v) {
if $*VM<config><osname> ne 'MSWin32'
@@ -25,18 +30,13 @@ our sub install(Str $dir = '.', Str $dest = "%*ENV<HOME>/.perl6/", :$v) {
}
}
for @files -> $file {
- my $target-dir = $file.dir.subst(/\.\//, $dest);
- mkdir $target-dir, :p;
- say "Installing $file" if $v.defined;
-# say "Starting copying $pmfile, sized {
-# $pmfile.Str.IO.stat.size} bytes";
-# my $t = time;
-# cp ~$file, "$target-dir/{$file.name}";
-# say "Done copying, took {time() - $t} seconds";
- if $*VM<config><osname> ne 'MSWin32' {
- run "cp $file $target-dir/{$file.name}";
- } else {
+ my $target-dir = $file.dir.subst(/^$dir\//, $dest);
+ mkdirp $target-dir;
+ say "Installing $file" if $v;
+ if $*VM<config><osname> eq 'MSWin32' {
run "copy $file $target-dir/{$file.name}";
+ } else {
+ run "cp $file $target-dir/{$file.name}";
}
}
}
View
@@ -10,8 +10,11 @@ our sub test(Str $dir = '.', Str $binary = 'perl6', :$v) {
}
if "$dir/t".IO ~~ :d {
my $x = $v ?? '-v' !! '-Q';
- my $command = "PERL6LIB=$dir/lib prove $x -e $binary -r $dir/t/";
+ my $cwd = cwd;
+ chdir $dir;
+ my $command = "PERL6LIB=lib prove $x -e $binary -r t/";
run $command and die 'Testing failed';
+ chdir $cwd;
}
}

0 comments on commit 7137209

Please sign in to comment.