class CompUnit::Repository::FileSystem { ... } class CompUnit::Repository::Installation { ... } class CompUnit::Repository::AbsolutePath { ... } class CompUnit::Repository::Unknown { ... } class CompUnit::Repository::NQP { ... } class CompUnit::Repository::Perl5 { ... } #?if jvm class CompUnit::Repository::JavaRuntime { ... } class CompUnit::Repository::Java { ... } #?endif #?if js class CompUnit::Repository::FileSystemWithRecording { ... } class CompUnit::Repository::NodeJs { ... } #?endif class CompUnit::RepositoryRegistry { my $lock := Lock.new; my $include-spec2cur := nqp::hash; my $custom-lib := nqp::hash(); proto method repository-for-spec(|) { * } multi method repository-for-spec( Str:D $spec, CompUnit::Repository :$next-repo --> CompUnit::Repository:D) { $spec ?? self.repository-for-spec( CompUnit::Repository::Spec.from-string($spec, 'file'), :$next-repo ) !! Nil } multi method repository-for-spec( CompUnit::Repository::Spec:D $spec, CompUnit::Repository :$next-repo, --> CompUnit::Repository:D) { my $short-id := $spec.short-id; my %options := $spec.options; my $path := $spec.path; my $class := short-id2class($short-id); if nqp::istype($class,CompUnit::Repository) { my $prefix := nqp::can($class,"absolutify") ?? $class.absolutify($path) !! $path; %options = $next-repo if $next-repo; self!register-repository( "$short-id#$prefix", $class.new(:$prefix, |%options) ); } else { CompUnit::Repository::Unknown.new( :path-spec($spec), :short-name($short-id) ) } } method !register-custom-lib-repository( str $type, str $id, CompUnit::Repository $repo ) { $lock.protect: { nqp::bindkey( $custom-lib, $type, nqp::ifnull( nqp::atkey($include-spec2cur,$id), nqp::bindkey($include-spec2cur,$id,$repo) ) ) } } method !register-repository(str $id, CompUnit::Repository $repo) { $lock.protect: { nqp::ifnull( nqp::atkey($include-spec2cur,$id), nqp::bindkey($include-spec2cur,$id,$repo) ) } } method setup-repositories() { my $raw-specs; # only look up environment once my $ENV := nqp::getattr(%*ENV,Map,'$!storage'); my $sep := $*SPEC.dir-sep; my $precomp-specs := nqp::ifnull(nqp::atkey($ENV,'RAKUDO_PRECOMP_WITH'),False); my CompUnit::Repository $next-repo; # starting up for creating precomp if $precomp-specs { # assume well formed strings $raw-specs := nqp::split(',',$precomp-specs); } # normal start up else { $raw-specs := nqp::list(); for Rakudo::Internals.INCLUDE -> $specs { nqp::push($raw-specs,$_) for parse-include-specS($specs); } if nqp::existskey($ENV,'RAKUDOLIB') { nqp::push($raw-specs,$_) for parse-include-specS(nqp::atkey($ENV,'RAKUDOLIB')); } if nqp::existskey($ENV,'RAKULIB') { nqp::push($raw-specs,$_) for parse-include-specS(nqp::atkey($ENV,'RAKULIB')); } if nqp::existskey($ENV,'PERL6LIB') { nqp::push($raw-specs,$_) for parse-include-specS(nqp::atkey($ENV,'PERL6LIB')); } # your basic repo chain $next-repo := CompUnit::Repository::AbsolutePath.new( :next-repo(CompUnit::Repository::NQP.new( :next-repo(CompUnit::Repository::Perl5.new( #?if jvm :next-repo(CompUnit::Repository::JavaRuntime.new) #?endif )) )) ); } # create reverted, unique list of path-specs my $unique := nqp::hash(); my $specs := nqp::list(); while nqp::elems($raw-specs) { my $repo-spec := nqp::shift($raw-specs); my str $path-spec = $repo-spec.Str; unless nqp::existskey($unique,$path-spec) { nqp::bindkey($unique,$path-spec,1); nqp::unshift($specs,$repo-spec); } } # set up and normalize $prefix if needed my str $prefix = nqp::ifnull( nqp::atkey($ENV,'RAKUDO_PREFIX'), nqp::gethllsym('default', 'SysConfig').rakudo-home() ); $prefix = $prefix.subst(:g, '/', $sep) if Rakudo::Internals.IS-WIN; # set up custom libs my str $core = 'inst#' ~ $prefix ~ $sep ~ 'core'; my str $vendor = 'inst#' ~ $prefix ~ $sep ~ 'vendor'; my str $site = 'inst#' ~ $prefix ~ $sep ~ 'site'; my str $home; my str $home-spec; if nqp::ifnull( nqp::atkey($ENV,'HOME'), nqp::concat( nqp::ifnull(nqp::atkey($ENV,'HOMEDRIVE'),''), nqp::ifnull(nqp::atkey($ENV,'HOMEPATH'),'') ) ) -> $home-path { $home = $home-path ~ $sep ~ '.raku'; $home-spec = 'inst#' ~ $home; } unless $precomp-specs { $next-repo := self!register-custom-lib-repository( 'core', $core, CompUnit::Repository::Installation.new( :prefix("$prefix/core"), :$next-repo ) ) unless nqp::existskey($unique,$core); $next-repo := self!register-custom-lib-repository( 'vendor', $vendor, CompUnit::Repository::Installation.new( :prefix("$prefix/vendor"), :$next-repo ) ) unless nqp::existskey($unique, $vendor); $next-repo := self!register-custom-lib-repository( 'site', $site, CompUnit::Repository::Installation.new( :prefix("$prefix/site"), :$next-repo ) ) unless nqp::existskey($unique, $site); $next-repo := self!register-custom-lib-repository( 'home', $home-spec, CompUnit::Repository::Installation.new( :prefix($home), :$next-repo ) ) if $home-spec and nqp::not_i(nqp::existskey($unique,$home-spec)); } # convert repo-specs to repos my $repos := nqp::hash(); while nqp::elems($specs) { my $spec := nqp::shift($specs); $next-repo := self.use-repository( self.repository-for-spec($spec), :current($next-repo)); nqp::bindkey($repos,$spec.Str,$next-repo); } # register manually set custom-lib repos $lock.protect: { unless nqp::existskey($custom-lib,'core') { my \repo := nqp::atkey($repos,$core); nqp::bindkey($custom-lib,'core',repo) if repo; } unless nqp::existskey($custom-lib,'vendor') { my \repo := nqp::atkey($repos,$vendor); nqp::bindkey($custom-lib,'vendor',repo) if repo; } unless nqp::existskey($custom-lib,'site') { my \repo := nqp::atkey($repos,$site); nqp::bindkey($custom-lib,'site',repo) if repo; } unless nqp::existskey($custom-lib,'home') { if $home-spec { my \repo := nqp::atkey($repos,$home-spec); nqp::bindkey($custom-lib,'home',repo) if repo; } } } $next-repo } method !remove-from-chain( CompUnit::Repository $repo, CompUnit::Repository $current --> Nil) { my $item := $current; while $item { if $item.next-repo === $repo { $item.next-repo = $repo.next-repo; last; } $item := $item.next-repo; } } method use-repository( CompUnit::Repository $repo, CompUnit::Repository :$current = $*REPO --> CompUnit::Repository:D) { if $current === $repo { $repo } else { self!remove-from-chain($repo, $current); $repo.next-repo = $current; PROCESS::<$REPO> := $repo; } } method repository-for-name(str $name) { $*REPO; # initialize if not yet done $lock.protect: { nqp::ifnull(nqp::atkey($custom-lib,$name),Nil) } } method register-name($name, CompUnit::Repository $repo) { $lock.protect: { nqp::bindkey($custom-lib, $name, $repo) } } method name-for-repository(CompUnit::Repository $repo) { $*REPO; # initialize if not yet done $lock.protect: { my $iter := nqp::iterator($custom-lib); while $iter { my \pair = nqp::shift($iter); return nqp::iterkey_s(pair) if nqp::iterval(pair).prefix eq $repo.prefix; } } Nil } method file-for-spec(Str $spec) { my @parts is List = $spec.split('#', 2); if @parts.elems == 2 { my $repo = self.repository-for-name(@parts[0]); return $repo.source-file(@parts[1]) if $repo.can('source-file'); } Nil } method run-script($script) { my @installations = $*REPO.repo-chain.grep(CompUnit::Repository::Installation); my @metas = @installations.map({ .files("bin/$script").head }).grep(*.defined); unless +@metas { @metas = flat @installations.map({ .files("bin/$script").Slip }).grep(*.defined); if +@metas { note "===SORRY!===\n" ~ "No candidate found for '$script' that match your criteria.\n" ~ "Did you perhaps mean one of these?"; my %caps = :name(['Distribution', 12]), :auth(['Author(ity)', 11]), :ver(['Version', 7]); for @metas -> $meta { for %caps.kv -> $caption, @opts { @opts[1] = max @opts[1], ($meta{$caption} // '').Str.chars } } note ' ' ~ %caps.values.map({ sprintf('%-*s', .[1], .[0]) }).join(' | '); for @metas -> $meta { note ' ' ~ %caps.kv.map( -> $k, $v { sprintf('%-*s', $v.[1], $meta{$k} // '') } ).join(' | ') } } else { note "===SORRY!===\nNo candidate found for '$script'.\n"; } exit 1; } my $meta = @metas.sort(*.).sort(*.).reverse.head; my $bin = $meta; require "$bin"; } method head() { # mostly usefull for access from NQP $*REPO } method resolve-unknown-repos($first-repo --> Nil) { my $repo := $first-repo; my $prev-repo; my $world := $*W; while nqp::isconcrete($repo) { if nqp::istype($repo,CompUnit::Repository::Unknown) { my $next-repo := $repo.next-repo; my $head := PROCESS::<$REPO>; PROCESS::<$REPO> := $next-repo; my $comp_unit := $next-repo.need( CompUnit::DependencySpecification.new( :short-name($repo.short-name)) ); PROCESS::<$REPO> := $head; # Cannot just use GLOBAL.WHO here as that gives a BOOTHash ($world ?? $world.find_single_symbol("GLOBAL").WHO !! GLOBAL.WHO) .merge-symbols($comp_unit.handle.globalish-package); $repo := self.repository-for-spec($repo.path-spec, :$next-repo); nqp::isconcrete($prev-repo) ?? ($prev-repo.next-repo = $repo) !! (PROCESS::<$REPO> := $repo); } $prev-repo := $repo; $repo := $repo.next-repo; } } # Handles any object repossession conflicts that occurred during module load, # or complains about any that cannot be resolved. method resolve_repossession_conflicts(@conflicts) { for @conflicts -> $orig is raw, $current is raw { # If it's a Stash in conflict, we make sure any original entries get # appropriately copied. if $orig.HOW.name($orig) eq 'Stash' { $current.merge-symbols($orig); } # We could complain about anything else, and may in the future; for # now, we let it pass by with "latest wins" semantics. } } #?if !js my constant $short-id2class = nqp::hash( #?endif #?if js my $short-id2class := nqp::hash( #?endif 'file', CompUnit::Repository::FileSystem, 'inst', CompUnit::Repository::Installation, 'ap', CompUnit::Repository::AbsolutePath, 'nqp', CompUnit::Repository::NQP, 'perl5', CompUnit::Repository::Perl5, #?if js 'nodejs', CompUnit::Repository::NodeJs, #?endif #?if jvm 'javart', CompUnit::Repository::JavaRuntime, 'java', CompUnit::Repository::Java, #?endif #?if js 'filerecording', CompUnit::Repository::FileSystemWithRecording, #?endif ); my $sid-lock := Lock.new; sub short-id2class(Str:D $short-id) is rw { Proxy.new( FETCH => { $sid-lock.protect( { nqp::ifnull( nqp::atkey($short-id2class,$short-id), nqp::if( nqp::istype((my \type := ::($short-id)),Failure), (type.defined || Any), # no unhandled Failure warnings nqp::if( nqp::can(type,"short-id") && (my str $id = type.short-id), nqp::ifnull( nqp::atkey($short-id2class,$id), nqp::bindkey($short-id2class,$id,type) ), (die "Class '{type.^name}' is not a 'CompUnit::Repository'") ) ) ) } ); }, STORE => -> $, $class { nqp::istype((my \type = ::($class)),Failure) ?? X::AdHoc.new( payload => "Must load class '$class' first" ).throw !! $sid-lock.protect: { nqp::bindkey($short-id2class,$short-id,type) } }, ); } sub parse-include-specS(Str:D $specs --> List:D) { my $found := nqp::create(IterationBuffer); my $default-short-id := 'file'; if $*RAKUDO_MODULE_DEBUG -> $RMD { $RMD("Parsing specs: $specs") } # for *all possible specs my $spec-list := nqp::split(',',$specs); while nqp::elems($spec-list) { if nqp::shift($spec-list).trim -> $spec { if CompUnit::Repository::Spec.from-string( $spec, $default-short-id ) -> $repo-spec { nqp::push($found,$repo-spec); $default-short-id := $repo-spec.short-id; } else { die "Don't know how to handle '$spec'"; } } } $found.List } } # vim: expandtab shiftwidth=4