Merge branch 'dist-interface' of git://github.com/ugexe/rakudo into u…

…gexe-dist-interface
rakudo · Jun 25, 2016 · a6d71f3 · a6d71f3
2 parents 6afd0bd + fc8c7af
commit a6d71f3
Show file tree

Hide file tree

Showing 9 changed files with 267 additions and 169 deletions.
diff --git a/src/core/CompUnit/Repository/FileSystem.pm b/src/core/CompUnit/Repository/FileSystem.pm
@@ -144,7 +144,10 @@ class CompUnit::Repository::FileSystem does CompUnit::Repository::Locally does C
     }
 
     method resource($dist-id, $key) {
-        $.prefix.parent.child('resources').child($key);
+        # We now save the 'resources/' part of a resource's path in files, i.e:
+        # "files" : [ "resources/libraries/xxx" => "resources/libraries/xxx.so" ]
+        # but we also want to root any path request to the CUR's resources directory
+        $.prefix.parent.child('resources').child($key.subst(/^resources\//, ""));
     }
 
     method precomp-store() returns CompUnit::PrecompilationStore {

diff --git a/src/core/CompUnit/Repository/Installable.pm b/src/core/CompUnit/Repository/Installable.pm
@@ -1,17 +1,6 @@
 role CompUnit::Repository::Installable does CompUnit::Repository {
     # Installs a distribution into the repository.
-    method install(
-        # A Distribution object 
-        Distribution $dist,
-        # A hash mapping entries in `provides` to a disk location that
-        # holds the source files; they will be copied (and may also be
-        # precompiled by some CompUnit::Repository implementations).
-        %sources,
-        %scripts?,
-        # A hash mapping entries in the `resources` to a disk location
-        # that holds the files; again, these will be copied and stored.
-        %resources?)
-        { ... }
+    method install(Distribution $dist) { ... }
 
     # Returns True if we can install modules (this will typically do a
     # .w check on the module database).

diff --git a/src/core/CompUnit/Repository/Installation.pm b/src/core/CompUnit/Repository/Installation.pm
diff --git a/src/core/Distribution.pm b/src/core/Distribution.pm
@@ -1,38 +1,93 @@
-class Distribution {
-    has $.name;
-    has $.auth;
-    has $.author;
-    has $.authority;
-    has $.api;
-    has $.ver;
-    has $.version;
-    has $.description;
-    has @.depends;
-    has %.provides;
-    has %.files;
-    has $.source-url;
-    method auth { $!auth // $!author // $!authority }
-    method ver  { $!ver // $!version }
-    method hash {
-        {
-            :$!name,
-            :$.auth,
-            :$.ver,
-            :$!description,
-            :@!depends,
-            :%!provides,
-            :%!files,
-            :$!source-url,
-        }
+# API to obtain the data of any addressable content
+role Distribution {
+    # `meta` provides an API to the meta data in META6 spec (s22)
+    #   -   A Distribution may be represented internally by some other
+    #       spec (such as using the file system itself for prereqs), as
+    #       long as it can also be represented as the META6 hash format
+    method meta(--> Hash) { ... }
+
+    # `content($content-id)` provides an API to the data itself
+    #   -   Use `.meta` to determine the $address of a specific $content-id
+    #   -   IO::Handle is meant to be a data stream that may or may not be available; for now
+    #       it would return an IO::Handle and have `.open.slurp-rest(:bin)` called on it. So if
+    #       a socket wants to handle this role currently it would have to wrap `open` or `.slurp-rest`
+    #       to handle any protocol negotiation as well as probably saving the data to a tmpfile and
+    #       return an IO::Handle to that
+    method content($content-id --> IO::Handle) { ... }
+}
+
+role Distribution::Locally {
+    has IO::Path $.prefix;
+    method content($address) {
+        my $handle = IO::Handle.new: path => IO::Path.new($address, :CWD($!prefix // $*CWD));
+        $handle // $handle.throw;
+    }
+}
+
+# A distribution passed to `CURI.install()` will get encapsulated in this
+# class, which normalizes the meta6 data and adds identifiers/content-id
+class CompUnit::Repository::Distribution {
+    has Distribution $!dist handles 'content';
+    has $!meta;
+    submethod BUILD(:$!meta, :$!dist) { }
+    method new(Distribution $dist) {
+        my $meta = $dist.meta.hash;
+        $meta<ver>  //= $meta<version>;
+        $meta<auth> //= $meta<authority> // $meta<author>;
+        self.bless(:$dist, :$meta);
     }
+    method meta { $!meta }
+
     method Str() {
-        return "{$.name}:ver<{$.ver  // ''}>:auth<{$.auth // ''}>:api<{$.api // ''}>";
+        return "{$.meta<name>}"
+        ~ ":ver<{$.meta<ver>   // ''}>"
+        ~ ":auth<{$.meta<auth> // ''}>"
+        ~ ":api<{$.meta<api>   // ''}>";
+
     }
+
     method id() {
         return nqp::sha1(self.Str);
     }
 }
 
+class Distribution::Hash does Distribution does Distribution::Locally {
+    has $!meta;
+    submethod BUILD(:$!meta, :$!prefix) { }
+    method new($hash, :$prefix) { self.bless(:meta($hash), :$prefix) }
+    method meta { $!meta }
+}
+
+class Distribution::Path does Distribution does Distribution::Locally {
+    has $!meta;
+    submethod BUILD(:$!meta, :$!prefix) { }
+    method new(IO::Path $prefix, IO::Path :$file is copy) {
+        my $path := ?$file ?? $file !! $prefix.child('META6.json');
+        die "No meta file located at {$path.abspath}" unless $path.e;
+        my $meta = Rakudo::Internals::JSON.from-json(slurp($path));
+
+        my sub ls-files($prefix, $subdir) {
+            my @stack = dir($prefix.child($subdir));
+            my @files = eager gather while ( @stack ) {
+                my IO::Path $current = @stack.pop;
+                my Str      $relpath = $current.relative($prefix);
+                take $relpath and next if $current.f;
+                next if $current.basename eq '.precomp';
+                @stack.append( |dir($current.absolute) ) if $current.d;
+            }
+        }
+
+        # generate `files` (special directories) directly from the file system
+        my @bins      = ls-files($prefix, 'bin');
+        my @resources = ls-files($prefix, 'resources');
+        my @files     = grep *.defined, unique(|$meta<files>, |@bins, |@resources);
+        $meta<files>  = @files;
+
+        self.bless(:$meta, :$prefix);
+    }
+    method meta { $!meta }
+}
+
 role CompUnit::Repository { ... }
 class Distribution::Resources does Associative {
     has Str $.dist-id;
@@ -57,7 +112,7 @@ class Distribution::Resources does Associative {
     }
 
     method AT-KEY($key) {
-        CompUnit::RepositoryRegistry.repository-for-spec($.repo).resource($.dist-id, $key)
+        CompUnit::RepositoryRegistry.repository-for-spec($.repo).resource($.dist-id, "resources/$key")
     }
 
     method Str() {

diff --git a/tools/build/Makefile-JVM.in b/tools/build/Makefile-JVM.in
@@ -378,27 +378,11 @@ j-install: j-all tools/build/create-jvm-runner.pl tools/build/install-core-dist.
 	$(CP) $(PERL6_JAR) $(DESTDIR)$(PERL6_LANG_DIR)/runtime
 	$(CP) $(PERL6_DEBUG_JAR) $(DESTDIR)$(PERL6_LANG_DIR)/runtime
 	$(CP) $(RUNTIME_JAR) $(DESTDIR)$(PERL6_LANG_DIR)/runtime
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/dist
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/sources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/resources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/bin
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/short
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/precomp
-	echo 1 >  $(DESTDIR)$(PERL6_LANG_DIR)/version
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/dist
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/sources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/resources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/bin
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/short
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/precomp
-	echo 1 >  $(DESTDIR)$(PERL6_LANG_DIR)/vendor/version
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/dist
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/sources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/resources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/bin
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/short
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/precomp
-	echo 1 >  $(DESTDIR)$(PERL6_LANG_DIR)/site/version
+	.@slash@$(J_RUNNER) tools/build/upgrade-repository.pl $(DESTDIR)$(PERL6_LANG_DIR)
+	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor
+	.@slash@$(J_RUNNER) tools/build/upgrade-repository.pl $(DESTDIR)$(PERL6_LANG_DIR)/vendor
+	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site
+	.@slash@$(J_RUNNER) tools/build/upgrade-repository.pl $(DESTDIR)$(PERL6_LANG_DIR)/site
 	.@slash@$(J_RUNNER) tools/build/install-core-dist.pl $(DESTDIR)$(PERL6_LANG_DIR)
 	$(PERL5) tools/build/create-jvm-runner.pl install "$(DESTDIR)" $(PREFIX) $(NQP_PREFIX) $(NQP_JARS)
 	$(PERL5) tools/build/create-jvm-runner.pl install-debug "$(DESTDIR)" $(PREFIX) $(NQP_PREFIX) $(NQP_JARS)

diff --git a/tools/build/Makefile-Moar.in b/tools/build/Makefile-Moar.in
@@ -266,28 +266,9 @@ m-install: m-all tools/build/create-moar-runner.pl tools/build/install-core-dist
 	$(CP) $(PERL6_MOAR) $(PERL6_DEBUG_MOAR) $(DESTDIR)$(PERL6_LANG_DIR)/runtime
 	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/runtime/dynext
 	$(CP) $(M_PERL6_OPS_DLL) $(DESTDIR)$(PERL6_LANG_DIR)/runtime/dynext
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/dist
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/sources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/resources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/bin
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/short
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/precomp
-	echo 1 >  $(DESTDIR)$(PERL6_LANG_DIR)/version
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/dist
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/sources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/resources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/bin
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/short
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/precomp
-	echo 1 >  $(DESTDIR)$(PERL6_LANG_DIR)/vendor/version
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/vendor/dist
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/dist
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/sources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/resources
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/bin
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/short
-	$(MKPATH) $(DESTDIR)$(PERL6_LANG_DIR)/site/precomp
-	echo 1 >  $(DESTDIR)$(PERL6_LANG_DIR)/site/version
+	.@slash@$(M_RUNNER) tools/build/upgrade-repository.pl $(DESTDIR)$(PERL6_LANG_DIR)
+	.@slash@$(M_RUNNER) tools/build/upgrade-repository.pl $(DESTDIR)$(PERL6_LANG_DIR)/vendor
+	.@slash@$(M_RUNNER) tools/build/upgrade-repository.pl $(DESTDIR)$(PERL6_LANG_DIR)/site
 	.@slash@$(M_RUNNER) tools/build/install-core-dist.pl $(DESTDIR)$(PERL6_LANG_DIR)
 	$(PERL5) tools/build/create-moar-runner.pl "$(MOAR)" perl6.moarvm $(DESTDIR)$(PREFIX)/bin/perl6-m "$(PERL6_LANG_DIR)/runtime" "" "$(M_LIBPATH)" "$(PERL6_LANG_DIR)/lib" "$(PERL6_LANG_DIR)/runtime"
 	$(PERL5) tools/build/create-moar-runner.pl "$(MOAR)" perl6-debug.moarvm $(DESTDIR)$(PREFIX)/bin/perl6-debug-m "$(PERL6_LANG_DIR)/runtime" "" "$(M_LIBPATH)" "$(PERL6_LANG_DIR)/lib" "$(PERL6_LANG_DIR)/runtime"

diff --git a/tools/build/install-core-dist.pl b/tools/build/install-core-dist.pl
@@ -15,16 +15,13 @@
     "inst#@*ARGS[0]",
     :next-repo(CompUnit::RepositoryRegistry.repository-for-name('perl').next-repo),
 );
-$*REPO.install(
-    Distribution.new(
-        name     => "CORE",
-        auth     => "perl",
-        ver      => $*PERL.version.Str,
-        provides => %provides,
-    ),
-    %provides,
-    :force,
-);
+my $dist = Distribution::Hash.new(%(
+    name     => "CORE",
+    auth     => "perl",
+    ver      => $*PERL.version.Str,
+    provides => %provides,
+), prefix => $*CWD);
+$*REPO.install($dist, :force);
 
 note "installed!";
 

diff --git a/tools/build/upgrade-repository.pl b/tools/build/upgrade-repository.pl
@@ -0,0 +1,3 @@
+CompUnit::Repository::Installation.new(:prefix(@*ARGS[0])).upgrade-repository;
+
+# vim: ft=perl6
diff --git a/tools/install-dist.pl b/tools/install-dist.pl
@@ -62,27 +62,22 @@
         :next-repo(CompUnit::RepositoryRegistry.repository-for-name($for)),
         :name($for),
     ).install(
-        Distribution.new(|$dist-dir.meta),
-        $dist-dir.sources,
-        $dist-dir.scripts,
-        $dist-dir.resources,
+        Distribution::Hash.new($dist-dir.meta, :prefix($from)),
     );
 
     $_.unlink for <version repo.lock precomp/.lock>.map: {"$to/$_".IO};
 }
 
-multi sub MAIN($from is copy = '.', :$to = 'site') {
+multi sub MAIN($from is copy = '.', :$to = 'site', Bool :$force) {
     $from = $from.IO;
     my $dist-dir = Distribution::Directory.new(path => $from);
 
     my $repo = $to ~~ /^\w+$/
         ?? CompUnit::RepositoryRegistry.repository-for-name($to)
         !! CompUnit::RepositoryRegistry.repository-for-spec($to);
     $repo.install(
-        Distribution.new(|$dist-dir.meta),
-        $dist-dir.sources,
-        $dist-dir.scripts,
-        $dist-dir.resources,
+        Distribution::Hash.new($dist-dir.meta, :prefix($from)),
+        :$force,
     );
 }