Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Turn short-name lookup files into directories 
This may become part of CompUnit::Repository::Installation format v1.
Having to change any already existing files on installation of a module makes
it more difficult to package modules for Linux distributions. So we replace
the short-name lookup files in a repo's short/ directory by directories.

The files there are named after the dist's hash and contain the version,
auth and api fields so we can find the one true candidate without having
to parse any JSON at all. Only the winner dist's JSON will even be read.

As version, auth and api are separated by newlines without any escaping,
those values themselves may no longer contain newlines. This should be a
very reasonable restriction in any case.
  • Loading branch information
@niner
niner committed Feb 20, 2016
1 parent edac531 commit 9c0f96f
Showing 1 changed file with 56 additions and 30 deletions.
86 changes: 56 additions & 30 deletions src/core/CompUnit/Repository/Installation.pm
View file
Expand Up @@ -3,6 +3,7 @@ class CompUnit::Repository::Installation does CompUnit::Repository::Locally does
has %!loaded;
has $!precomp;
has $!id;
has Int $!version;

my $verbose := nqp::getenvhash<RAKUDO_LOG_PRECOMP>;

Expand Down Expand Up @@ -99,9 +100,9 @@ sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) {
my $short-dir = $.prefix.child('short');
$short-dir.mkdir unless $short-dir.e;
my $id = nqp::sha1($name);
my $lookup = $short-dir.child($id).open(:a);
$lookup.say: $dist.id;
$lookup.close;
my $lookup = $short-dir.child($id);
$lookup.mkdir;
$lookup.child($dist.id).spurt("{$dist.ver // ''}\n{$dist.auth // ''}\n{$dist.api // ''}\n");
}

method !remove-dist-from-short-name-lookup-files($dist) {
Expand All @@ -110,14 +111,8 @@ sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) {

my $id = $dist.id;

for $short-dir.dir -> $file {
my $filtered = ($file.lines ∖ $id);
if $filtered.elems > 0 {
$file.spurt: $filtered.keys.sort.map({"$_\n"}).join('');
}
else {
$file.unlink;
}
for $short-dir.dir -> $dir {
$dir.child($id).unlink;
}
}

Expand All @@ -126,13 +121,46 @@ sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) {
nqp::sha1($id)
}

method !read-dist($id) {
my $dist = from-json($.prefix.child('dist').child($id).slurp);
$dist<ver> = $dist<ver> ?? Version.new( ~$dist<ver> ) !! Version.new('0');
$dist
}

method !repository-version(--> Int) {
return $!version if defined $!version;
my $version-file = $.prefix.child('version');
return $!version = 0 unless $version-file ~~ :f;
$!version = $version-file.slurp.Int
}

method !upgrade-repository(Int $version) {
if ($version < 1) {
$.prefix.child('version').spurt('1');
my $short-dir = $.prefix.child('short');
for $short-dir.dir -> $file {
my @ids = $file.lines.unique;
$file.unlink;
$file.mkdir;
for @ids -> $id {
my $dist = self!read-dist($id);
$file.child($id).spurt("{$dist<ver> // ''}\n{$dist<auth> // ''}\n{$dist<api> // ''}\n");
}
}
}
$!version = 1;
}

method install(Distribution $dist, %sources, %scripts?, %resources?, :$force) {
$!lock.protect( {
my @*MODULES;
my $path = self!writeable-path or die "No writeable path found, $.prefix not writeable";
my $lock //= $.prefix.child('repo.lock').open(:create, :w);
$lock.lock(2);

my $version = self!repository-version;
self!upgrade-repository($version) unless $version == 1;

my $dist-id = $dist.id;
my $dist-dir = self!dist-dir;
if not $force and $dist-dir.child($dist-id) ~~ :e {
Expand Down Expand Up @@ -247,21 +275,14 @@ sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) {
my $prefix = self.prefix;
my $lookup = $prefix.child('short').child(nqp::sha1($name));
if $lookup.e {
my $dist-dir = self!dist-dir;
for $lookup.lines -> $dist-id {
my $dist = from-json($dist-dir.child($dist-id).slurp);
my $dver = $dist<ver>
?? nqp::istype($dist<ver>,Version)
?? $dist<ver>
!! Version.new( $dist<ver> )
!! Version.new('0');
my $dist = self!read-dist($dist-id);

if (!$name || $dist<name> ~~ $name)
&& (!$auth || $dist<auth> ~~ $auth)
&& (!$ver || $dver ~~ $ver) {
&& (!$ver || $dist<ver> ~~ $ver) {
with $dist<files>{$file} {
my $candi = %$dist;
$candi<ver> = $dver;
$candi<files>{$file} = $prefix.abspath ~ '/resources/' ~ $candi<files>{$file}
unless $candi<files>{$file} ~~ /^$prefix/;
@candi.push: $candi;
Expand All @@ -274,19 +295,24 @@ sub MAIN(:$name is copy, :$auth, :$ver, *@, *%) {

method !matching-dist(CompUnit::DependencySpecification $spec) {
if $spec.from eq 'Perl6' {
my $version = self!repository-version;
my $lookup = $.prefix.child('short').child(nqp::sha1($spec.short-name));
if $lookup.e {
my $dist-dir = $.prefix.child('dist');
my @dists = $lookup.lines.unique.map({
$_ => from-json($dist-dir.child($_).slurp)
}).grep({
$_.value<auth> ~~ $spec.auth-matcher
and Version.new(~$_.value<ver> || '0') ~~ $spec.version-matcher
and $_.value<provides>{$spec.short-name}:exists
});
my @dists = (
$version < 1
?? $lookup.lines.unique.map({
$_ => self!read-dist($_)
})
!! $lookup.dir.map({
my ($ver, $auth, $api) = $_.slurp.split("\n");
$_.basename => {ver => Version.new( $ver || 0 ), auth => $auth, api => $api}
})
).grep({
$_.value<auth> ~~ $spec.auth-matcher
and $_.value<ver> ~~ $spec.version-matcher
});
for @dists.sort(*.value<ver>).reverse.map(*.kv) -> ($dist-id, $dist) {
$dist<ver> = $dist<ver> ?? Version.new( ~$dist<ver> ) !! Version.new('0');
return ($dist-id, $dist);
return ($dist-id, $version < 1 ?? $dist !! self!read-dist($dist-id));
}
}
}
Expand Down

0 comments on commit 9c0f96f

Please sign in to comment.