From 54b69eba8141785d1839ade4e161e7d06fb6a800 Mon Sep 17 00:00:00 2001
From: Tobias Leich <email@froggs.de>
Date: Thu, 25 Sep 2014 21:41:32 +0200
Subject: add script that creates panda state file

So after installing star panda will know what modules are installed.
When someone then will install a module that depends on a shipped module,
the shipped (and known working) dependency will be used by default.
---
 tools/build/panda-state.p6 | 57 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)
 create mode 100644 tools/build/panda-state.p6

(limited to 'tools/build/panda-state.p6')

diff --git a/tools/build/panda-state.p6 b/tools/build/panda-state.p6
new file mode 100644
index 0000000..300514d
--- /dev/null
+++ b/tools/build/panda-state.p6
@@ -0,0 +1,57 @@
+
+mkdir 'install';
+mkdir 'install/languages';
+mkdir 'install/languages/perl6';
+mkdir 'install/languages/perl6/site';
+mkdir 'install/languages/perl6/site/panda';
+
+my $state-file    = 'install/languages/perl6/site/panda/state';
+my $projects-file = 'install/languages/perl6/site/panda/projects.json';
+
+fetch-projects-json($projects-file);
+
+my $projects = from-json $projects-file.IO.slurp;
+
+# In case we ship a project that is just a fork of a project listed in the ecosystem, add
+# the mapping here.
+my %ex =
+    'git://github.com/FROGGS/perl6-digest-md5' => 'git://github.com/cosimo/perl6-digest-md5',
+;
+
+# Walk the submodules and put its project information in panda's state file.
+my $fh = $state-file.IO.open(:w);
+for '.gitmodules'.IO.lines.grep(/^\turl/).map({ /$<url>=[\S+]$/; ~$<url> }) -> $url {
+    my $p          = $projects.first({$_.<source-url> ~~ /^ "{%ex{$url} // $url}" '.git'? $/});
+    $p<repo-type>  = 'git';
+    $p<source-url> = $url;
+    $fh.say: $p<name> ~ ' installed ' ~ to-json($p).subst(/\n+/, '', :g);
+}
+$fh.close;
+
+say $state-file;
+say $projects-file;
+
+sub fetch-projects-json($to) {
+    try unlink $to;
+    my $s;
+    if %*ENV<http_proxy> {
+        my ($host, $port) = %*ENV<http_proxy>.split('/').[2].split(':');
+        $s = IO::Socket::INET.new(host=>$host, port=>$port.Int);
+        $s.send("GET http://feather.perl6.nl:3000/projects.json HTTP/1.1\nHost: feather.perl6.nl\nAccept: */*\nConnection: Close\n\n");
+    }
+    else {
+        $s = IO::Socket::INET.new(:host<feather.perl6.nl>, :port(3000));
+        $s.send("GET /projects.json HTTP/1.0\n\n");
+    }
+    my ($buf, $g) = '';
+    $buf ~= $g while $g = $s.get;
+
+    if %*ENV<http_proxy> {
+        $buf.=subst(:g,/'git://'/,'http://');
+    }
+    
+    given open($to, :w) {
+        .say: $buf.split(/\r?\n\r?\n/, 2)[1];
+        .close;
+    }
+}
-- 
cgit v1.1