├── .github ├── FUNDING.yml ├── ISSUE_TEMPLATE.md └── workflows │ └── tests.yml ├── bin └── zef ├── .gitignore ├── t ├── 00-load.rakutest ├── identity.rakutest ├── fetch.rakutest ├── build.rakutest ├── test.rakutest ├── extract.rakutest ├── install.rakutest ├── repository.rakutest └── utils-filesystem.rakutest ├── lib ├── Zef │ ├── Config.rakumod │ ├── Identity.rakumod │ ├── Report.rakumod │ ├── Service │ │ ├── InstallRakuDistribution.rakumod │ │ ├── Shell │ │ │ ├── Test.rakumod │ │ │ ├── wget.rakumod │ │ │ ├── curl.rakumod │ │ │ ├── LegacyBuild.rakumod │ │ │ ├── unzip.rakumod │ │ │ ├── DistributionBuilder.rakumod │ │ │ └── tar.rakumod │ │ ├── TAP.rakumod │ │ ├── FileReporter.rakumod │ │ └── FetchPath.rakumod │ ├── Distribution │ │ ├── DependencySpecification.rakumod │ │ └── Local.rakumod │ ├── Build.rakumod │ ├── Install.rakumod │ ├── Test.rakumod │ ├── Fetch.rakumod │ ├── Utils │ │ ├── SystemQuery.rakumod │ │ ├── FileSystem.rakumod │ │ └── URI.rakumod │ ├── Extract.rakumod │ ├── Distribution.rakumod │ └── Repository │ │ └── LocalCache.rakumod └── Zef.rakumod ├── META6.json ├── xt ├── install.rakutest └── repository.rakutest ├── resources └── config.json └── LICENSE /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: [ugexe] 2 | -------------------------------------------------------------------------------- /bin/zef: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env raku 2 | use v6.d; 3 | use Zef::CLI; 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.moarvm 2 | *.jar 3 | tmp/ 4 | lib/.precomp/ 5 | .precomp/ 6 | .idea/ 7 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | ## Context 4 | 5 | 6 | ## Expected Behavior 7 | 8 | 9 | ## Actual Behavior 10 | 11 | 12 | ## Steps to Reproduce 13 | 14 | 15 | 16 | ## Your Environment 17 | 18 | * raku -v 19 | * zef list --installed 20 | -------------------------------------------------------------------------------- /t/00-load.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 2; 4 | 5 | subtest 'Core' => { 6 | use-ok("Zef"); 7 | # Just `use Zef::CLI` will make it output usage 8 | # use-ok("Zef::CLI"); 9 | use-ok("Zef::Build"); 10 | use-ok("Zef::Config"); 11 | use-ok("Zef::Extract"); 12 | use-ok("Zef::Identity"); 13 | use-ok("Zef::Test"); 14 | use-ok("Zef::Install"); 15 | use-ok("Zef::Fetch"); 16 | use-ok("Zef::Client"); 17 | 18 | use-ok("Zef::Repository"); 19 | use-ok("Zef::Repository::LocalCache"); 20 | use-ok("Zef::Repository::Ecosystems"); 21 | 22 | use-ok("Zef::Distribution"); 23 | use-ok("Zef::Distribution::DependencySpecification"); 24 | use-ok("Zef::Distribution::Local"); 25 | 26 | use-ok("Zef::Utils::FileSystem"); 27 | use-ok("Zef::Utils::SystemQuery"); 28 | use-ok("Zef::Utils::URI"); 29 | } 30 | 31 | subtest 'Plugins' => { 32 | use-ok("Zef::Service::FetchPath"); 33 | use-ok("Zef::Service::TAP"); 34 | use-ok("Zef::Service::InstallRakuDistribution"); 35 | use-ok("Zef::Service::FileReporter"); 36 | use-ok("Zef::Service::Shell::DistributionBuilder"); 37 | use-ok("Zef::Service::Shell::LegacyBuild"); 38 | use-ok("Zef::Service::Shell::Test"); 39 | use-ok("Zef::Service::Shell::unzip"); 40 | use-ok("Zef::Service::Shell::tar"); 41 | use-ok("Zef::Service::Shell::curl"); 42 | use-ok("Zef::Service::Shell::git"); 43 | use-ok("Zef::Service::Shell::wget"); 44 | } 45 | -------------------------------------------------------------------------------- /t/identity.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 6; 4 | 5 | use Zef::Identity; 6 | 7 | 8 | subtest 'Require spec - exact' => { 9 | my @variations = ( 10 | 'Net::HTTP:ver<1.0>:auth>', 11 | 'Net::HTTP:auth>:ver<1.0>:api<>', 12 | ); 13 | 14 | for @variations -> $identity { 15 | my $ident = Zef::Identity.new($identity); 16 | 17 | is $ident.auth, 'Foo Bar '; 18 | is $ident.name, 'Net::HTTP'; 19 | is $ident.version, '1.0'; 20 | } 21 | } 22 | 23 | 24 | subtest 'Require spec - range *' => { 25 | my @variations = ( 26 | "Net::HTTP:ver<*>:auth", 27 | ); 28 | 29 | for @variations -> $identity { 30 | my $ident = Zef::Identity.new($identity); 31 | 32 | is $ident.auth, 'github:ugexe'; 33 | is $ident.name, 'Net::HTTP'; 34 | is $ident.version, '*'; 35 | } 36 | } 37 | 38 | 39 | subtest 'Require spec - range +' => { 40 | my @variations = ( 41 | "Net::HTTP:ver<1.0+>:auth", 42 | "Net::HTTP:auth:ver<1.0+>:api<>", 43 | ); 44 | 45 | for @variations -> $identity { 46 | my $ident = Zef::Identity.new($identity); 47 | 48 | is $ident.auth, 'github:ugexe'; 49 | is $ident.name, 'Net::HTTP'; 50 | is $ident.version, '1.0+'; 51 | } 52 | } 53 | 54 | 55 | subtest 'str2identity' => { 56 | ok ?str2identity("***not valid***"); 57 | 58 | subtest 'exact' => { 59 | my $expected = "Net::HTTP:ver<1.0+>:auth"; 60 | my $require = "Net::HTTP:ver<1.0+>:auth:api<>"; 61 | my $i-require = str2identity($require); 62 | 63 | is $i-require, $expected; 64 | } 65 | 66 | subtest 'not exact' => { 67 | my $require = "Net::HTTP"; 68 | my $i-require = str2identity($require); 69 | 70 | is $i-require, 'Net::HTTP'; 71 | } 72 | 73 | subtest 'root namespace' => { 74 | my $require = "HTTP"; 75 | my $i-require = str2identity($require); 76 | 77 | is $i-require, 'HTTP'; 78 | } 79 | } 80 | 81 | 82 | subtest 'identity2hash' => { 83 | my $require = "Net::HTTP:ver<1.0+>:auth"; 84 | ok ?identity2hash("***not valid***"); 85 | 86 | my %i-require = identity2hash($require); 87 | 88 | is %i-require, 'Net::HTTP'; 89 | is %i-require, '1.0+'; 90 | is %i-require, 'github:ugexe'; 91 | } 92 | 93 | 94 | subtest 'hash2identity' => { 95 | my %hash = %( :name, :ver<1.0+>, :auth ); 96 | ok ?hash2identity("***not valid***"); 97 | 98 | my $i-require = hash2identity(%hash); 99 | 100 | is $i-require, "Net::HTTP:ver<1.0+>:auth"; 101 | } 102 | -------------------------------------------------------------------------------- /lib/Zef/Config.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | 4 | module Zef::Config { 5 | our sub parse-file($path) { 6 | my %config = %(Zef::from-json( $path.IO.slurp )); 7 | 8 | my $homedir = $*HOME.IO.absolute; 9 | my $tempdir = $*TMPDIR.IO.absolute; 10 | 11 | for %config -> $node { 12 | if $node.key.ends-with('Dir') { 13 | %config{$node.key} = $node.value.subst(/'{$*HOME}' || '$*HOME'/, $homedir // $tempdir, :g); 14 | %config{$node.key} = $node.value.subst(/'{$*TMPDIR}' || '$*TMPDIR'/, $tempdir, :g); 15 | %config{$node.key} = $node.value.subst(/'{$*PID}' || '$*PID'/, $*PID, :g); 16 | %config{$node.key} = $node.value.subst(/'{time}'/, time, :g); 17 | } 18 | 19 | with %*ENV{sprintf 'ZEF_CONFIG_%s', $node.key.uc} { 20 | %config{$node.key} = $_ 21 | } 22 | } 23 | 24 | %config //= 'auto'; 25 | 26 | # XXX: config upgrade - just remove this in future when no one is looking 27 | %config //= %config:delete; 28 | 29 | %config; 30 | } 31 | 32 | our sub guess-path { 33 | my %default-conf; 34 | my IO::Path $local-conf-path; 35 | my @path-candidates = ( 36 | (%*ENV // "$*HOME/.config").IO.child('/zef/config.json'), 37 | %?RESOURCES.IO, 38 | ); 39 | for @path-candidates -> $path { 40 | if $path.e { 41 | %default-conf = try { parse-file($path) } // Hash.new; 42 | die "Failed to parse the zef config file '$path'" if !%default-conf; 43 | $local-conf-path = $path; 44 | last; 45 | } 46 | } 47 | die "Failed to find the zef config file at: {@path-candidates.join(', ')}" 48 | unless $local-conf-path.defined and $local-conf-path.e; 49 | die "Failed to parse a zef config file at $local-conf-path" 50 | if !%default-conf; 51 | return $local-conf-path; 52 | } 53 | 54 | our sub plugin-lookup($config) { 55 | my $lookup; 56 | my sub do-lookup($node) { 57 | if $node ~~ Hash { 58 | for @$node -> $sub-node { 59 | if $sub-node.value ~~ Str | Int && $sub-node.key eq any() { 60 | $lookup{$sub-node.value}.push($node); 61 | next; 62 | } 63 | do-lookup($sub-node.value); 64 | } 65 | } 66 | elsif $node ~~ Array { 67 | do-lookup($_) for $node.cache; 68 | } 69 | } 70 | do-lookup($config); 71 | $lookup; 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /lib/Zef/Identity.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | class Zef::Identity { 4 | has $.name; 5 | has $.version; 6 | has $.auth; 7 | has $.api; 8 | has $.from; 9 | 10 | my grammar REQUIRE { 11 | regex TOP { ^^ [':' ]* $$ } 12 | 13 | regex name { <-restricted +name-sep>+ } 14 | token key { <-restricted>+ } 15 | regex value { '<' ~ '>' [<( [[ |\<|\\> . ]+?]* %% ['\\' . ]+ )>] } 16 | 17 | token restricted { [':' | '<' | '>' | '(' | ')'] } 18 | token name-sep { < :: > } 19 | } 20 | 21 | my class REQUIRE::Actions { 22 | method TOP($/) { make %('name'=> $/.made, %($/ Z=> $/>>.ast)) if $/ } 23 | 24 | method name($/) { make $/.Str } 25 | method key($/) { my $str = make $/.Str; ($str eq 'ver') ?? 'version' !! $str } 26 | method value($/) { make $/.Str } 27 | } 28 | 29 | proto method new(|) {*} 30 | multi method new(Str :$name!, :ver(:$version), :$auth, :$api, :$from) { 31 | self.bless(:$name, :$version, :$auth, :$api, :$from); 32 | } 33 | 34 | multi method new(Str $id) { 35 | if $id.starts-with('.' | '/') { 36 | self.bless( 37 | name => $id, 38 | version => '', 39 | auth => '', 40 | api => '', 41 | from => '', 42 | ); 43 | } 44 | elsif REQUIRE.parse($id, :actions(REQUIRE::Actions)).ast -> $ident { 45 | self.bless( 46 | name => ~($ident // ''), 47 | version => ~($ident.first(*.defined) // ''), 48 | auth => ~($ident // '').trans(['\<', '\>'] => ['<', '>']), 49 | api => ~($ident // ''), 50 | from => ~($ident || 'Raku'), 51 | ); 52 | } 53 | } 54 | 55 | # Acme::Foo::SomeModule:auth:ver('1.0') 56 | method identity { 57 | $!name 58 | ~ (($!version // '' ) ne ('*' | '') ?? ":ver<" ~ $!version ~ ">" !! '') 59 | ~ (($!auth // '' ) ne ('*' | '') ?? ":auth<" ~ $!auth ~ ">" !! '') 60 | ~ (($!api // '' ) ne ('*' | '') ?? ":api<" ~ $!api ~ ">" !! '') 61 | ~ (($!from // '' ) ne ('Raku' | 'Perl6' | '') ?? ":from<" ~ $!from ~ ">" !! ''); 62 | } 63 | 64 | method hash { 65 | my %hash; 66 | %hash = $!name // ''; 67 | %hash = $!version // ''; 68 | %hash = $!auth // ''; 69 | %hash = $!api // ''; 70 | %hash = $!from // ''; 71 | %hash; 72 | } 73 | } 74 | 75 | sub str2identity($str) is export { 76 | # todo: when $str is a path 77 | Zef::Identity.new($str).?identity // $str; 78 | } 79 | 80 | sub identity2hash($identity) is export { 81 | Zef::Identity.new($identity).?hash; 82 | } 83 | 84 | sub hash2identity($hash) is export { 85 | Zef::Identity.new(|$hash).?identity; 86 | } 87 | -------------------------------------------------------------------------------- /t/fetch.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 1; 4 | 5 | use Zef; 6 | use Zef::Fetch; 7 | 8 | 9 | subtest 'Zef::Fetch.fetch' => { 10 | subtest 'Two fetchers, first does not match/handle uri' => { 11 | my class Mock::Fetcher::One does Fetcher { 12 | method fetch-matcher(|--> False) { } 13 | 14 | method fetch($, $) { die 'should not get called' } 15 | } 16 | 17 | my class Mock::Fetcher::Two does Fetcher { 18 | method fetch-matcher(|--> True) { } 19 | 20 | method fetch($, $to) { $to } 21 | } 22 | 23 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 24 | my $fetcher = Zef::Fetch.new but role :: { method plugins(|--> List) { Mock::Fetcher::One.new, Mock::Fetcher::Two.new } }; 25 | is $fetcher.fetch(Candidate.new(:uri($*CWD)), $save-to.absolute), $save-to.absolute; 26 | try $save-to.rmdir; 27 | } 28 | 29 | subtest 'Two fetchers, first not capable of handling given uri' => { 30 | my class Mock::Fetcher::One does Fetcher { 31 | method fetch-matcher(|--> False) { } 32 | 33 | method fetch($, $) { die 'should not get called' } 34 | } 35 | 36 | my class Mock::Fetcher::Two does Fetcher { 37 | method fetch-matcher(|--> True) { } 38 | 39 | method fetch($, $to) { $to } 40 | } 41 | 42 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 43 | my $fetcher = Zef::Fetch.new but role :: { method plugins(|--> List) { Mock::Fetcher::One.new, Mock::Fetcher::Two.new } }; 44 | is $fetcher.fetch(Candidate.new(:uri($*CWD)), $save-to.absolute), $save-to.absolute; 45 | try $save-to.rmdir; 46 | } 47 | 48 | subtest 'Two fetchers, first fails' => { 49 | my class Mock::Fetcher::One does Fetcher { 50 | method fetch-matcher(|--> True) { } 51 | 52 | method fetch($, $ --> Nil) { } 53 | } 54 | 55 | my class Mock::Fetcher::Two does Fetcher { 56 | method fetch-matcher(|--> True) { } 57 | 58 | method fetch($, $to) { $to } 59 | } 60 | 61 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 62 | my $fetcher = Zef::Fetch.new but role :: { method plugins(|--> List) { Mock::Fetcher::One.new, Mock::Fetcher::Two.new } }; 63 | is $fetcher.fetch(Candidate.new(:uri($*CWD)), $save-to.absolute), $save-to.absolute; 64 | try $save-to.rmdir; 65 | } 66 | 67 | subtest 'Two fetchers, first times out' => { 68 | my constant timeout = 1; 69 | 70 | my class Mock::Fetcher::One does Fetcher { 71 | method fetch-matcher(|--> True) { } 72 | 73 | method fetch($, $) { sleep(timeout * 5); timeout; } 74 | } 75 | 76 | my class Mock::Fetcher::Two does Fetcher { 77 | method fetch-matcher(|--> True) { } 78 | 79 | method fetch($, $to) { $to } 80 | } 81 | 82 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 83 | my $fetcher = Zef::Fetch.new but role :: { method plugins(|--> List) { Mock::Fetcher::One.new, Mock::Fetcher::Two.new } }; 84 | is $fetcher.fetch(Candidate.new(:uri($*CWD)), $save-to.absolute, :timeout(timeout)), $save-to.absolute; 85 | try $save-to.rmdir; 86 | } 87 | } 88 | 89 | 90 | done-testing; -------------------------------------------------------------------------------- /lib/Zef/Report.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | 4 | class Zef::Report does Pluggable does Reporter { 5 | 6 | =begin pod 7 | 8 | =title class Zef::Report 9 | 10 | =subtitle A configurable implementation of the Reporter interface 11 | 12 | =head1 Synopsis 13 | 14 | =begin code :lang 15 | 16 | use Zef; 17 | use Zef::Report; 18 | use Zef::Distribution::Local; 19 | 20 | # Setup with a single installer backend 21 | my $reporter = Zef::Report.new( 22 | backends => [ 23 | { module => "Zef::Service::FileReporter" }, 24 | ], 25 | ); 26 | 27 | # Assuming our current directory is a raku distribution... 28 | my $dist-to-report = Zef::Distribution::Local.new($*CWD); 29 | my $candidate = Candidate.new(dist => $dist-to-report); 30 | my $logger = Supplier.new andthen *.Supply.tap: -> $m { say $m. } 31 | 32 | # ...report the distribution using the all available backends 33 | my $reported = so $reporter.report($candidate, :$logger); 34 | say $reported ?? 'Reported OK' !! 'Something went wrong...'; 35 | 36 | =end code 37 | 38 | =head1 Description 39 | 40 | A C class that uses 1 or more other C instances as backends. It abstracts the logic 41 | to do 'report this distribution with every backend that supports the given distribution'. 42 | 43 | =head1 Methods 44 | 45 | =head2 method report 46 | 47 | method report(Candidate $candi, Supplier :$logger) 48 | 49 | Reports information about the distribution C<$candi.dist> to a temporary file (the file can be discovered 50 | from the output message emitted). 51 | 52 | An optional C<:$logger> can be supplied to receive events about what is occurring. 53 | 54 | Returns C if the reporting succeeded. 55 | 56 | =end pod 57 | 58 | 59 | submethod TWEAK(|) { 60 | @ = self.plugins; # preload plugins 61 | } 62 | 63 | #| Report basic information about this Candidate to a temp file 64 | method report(Candidate $candi, Supplier :$logger) { 65 | my $reporters := self.plugins.grep(*.so).cache; 66 | 67 | my $stdout = Supplier.new; 68 | my $stderr = Supplier.new; 69 | if ?$logger { 70 | $stdout.Supply.grep(*.defined).act: -> $out { $logger.emit({ level => VERBOSE, stage => REPORT, phase => LIVE, candi => $candi, message => $out }) } 71 | $stderr.Supply.grep(*.defined).act: -> $err { $logger.emit({ level => ERROR, stage => REPORT, phase => LIVE, candi => $candi, message => $err }) } 72 | } 73 | 74 | my @reports = $reporters.map: -> $reporter { 75 | if ?$logger { 76 | $logger.emit({ level => DEBUG, stage => REPORT, phase => START, candi => $candi, message => "Reporting with plugin: {$reporter.^name}" }); 77 | } 78 | 79 | my $report = $reporter.report($candi, :$stdout, :$stderr); 80 | $report; 81 | } 82 | 83 | $stdout.done(); 84 | $stderr.done(); 85 | 86 | return @reports.grep(*.defined); 87 | } 88 | } 89 | -------------------------------------------------------------------------------- /META6.json: -------------------------------------------------------------------------------- 1 | { 2 | "meta-version" : "0", 3 | "raku" : "6.d", 4 | "name" : "zef", 5 | "api" : "0", 6 | "version" : "1.0.0", 7 | "auth" : "zef:ugexe", 8 | "description" : "Raku Module Management", 9 | "license" : "Artistic-2.0", 10 | "build-depends" : [ ], 11 | "test-depends" : [ "Test" ], 12 | "depends" : [ "NativeCall" ], 13 | "provides" : { 14 | "Zef" : "lib/Zef.rakumod", 15 | "Zef::Build" : "lib/Zef/Build.rakumod", 16 | "Zef::CLI" : "lib/Zef/CLI.rakumod", 17 | "Zef::Client" : "lib/Zef/Client.rakumod", 18 | "Zef::Config" : "lib/Zef/Config.rakumod", 19 | "Zef::Extract" : "lib/Zef/Extract.rakumod", 20 | "Zef::Identity" : "lib/Zef/Identity.rakumod", 21 | "Zef::Install" : "lib/Zef/Install.rakumod", 22 | "Zef::Test" : "lib/Zef/Test.rakumod", 23 | "Zef::Fetch" : "lib/Zef/Fetch.rakumod", 24 | "Zef::Report" : "lib/Zef/Report.rakumod", 25 | 26 | "Zef::Repository" : "lib/Zef/Repository.rakumod", 27 | "Zef::Repository::LocalCache" : "lib/Zef/Repository/LocalCache.rakumod", 28 | "Zef::Repository::Ecosystems" : "lib/Zef/Repository/Ecosystems.rakumod", 29 | 30 | "Zef::Distribution" : "lib/Zef/Distribution.rakumod", 31 | "Zef::Distribution::DependencySpecification" : "lib/Zef/Distribution/DependencySpecification.rakumod", 32 | "Zef::Distribution::Local" : "lib/Zef/Distribution/Local.rakumod", 33 | 34 | "Zef::Service::FetchPath" : "lib/Zef/Service/FetchPath.rakumod", 35 | "Zef::Service::TAP" : "lib/Zef/Service/TAP.rakumod", 36 | "Zef::Service::FileReporter" : "lib/Zef/Service/FileReporter.rakumod", 37 | 38 | "Zef::Service::InstallRakuDistribution" : "lib/Zef/Service/InstallRakuDistribution.rakumod", 39 | "Zef::Service::Shell::DistributionBuilder" : "lib/Zef/Service/Shell/DistributionBuilder.rakumod", 40 | 41 | "Zef::Service::Shell::LegacyBuild" : "lib/Zef/Service/Shell/LegacyBuild.rakumod", 42 | "Zef::Service::Shell::Test" : "lib/Zef/Service/Shell/Test.rakumod", 43 | "Zef::Service::Shell::unzip" : "lib/Zef/Service/Shell/unzip.rakumod", 44 | "Zef::Service::Shell::tar" : "lib/Zef/Service/Shell/tar.rakumod", 45 | "Zef::Service::Shell::curl" : "lib/Zef/Service/Shell/curl.rakumod", 46 | "Zef::Service::Shell::git" : "lib/Zef/Service/Shell/git.rakumod", 47 | "Zef::Service::Shell::wget" : "lib/Zef/Service/Shell/wget.rakumod", 48 | 49 | "Zef::Utils::FileSystem" : "lib/Zef/Utils/FileSystem.rakumod", 50 | "Zef::Utils::SystemQuery" : "lib/Zef/Utils/SystemQuery.rakumod", 51 | "Zef::Utils::URI" : "lib/Zef/Utils/URI.rakumod" 52 | }, 53 | "resources" : [ 54 | "config.json" 55 | ], 56 | "authors" : [ 57 | "Nick Logan", 58 | "Tony O'Dell" 59 | ], 60 | "support" : { 61 | "bugtracker" : "https://github.com/ugexe/zef/issues", 62 | "irc" : "ircs://irc.libera.chat:6697/raku-zef", 63 | "source" : "https://github.com/ugexe/zef.git" 64 | }, 65 | "tags" : [ 66 | "package-manager", 67 | "module-installer", 68 | "meta-search", 69 | "distribution", 70 | "ecosystem", 71 | "cpan", 72 | "toolchain" 73 | ] 74 | } 75 | -------------------------------------------------------------------------------- /t/build.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 1; 4 | 5 | use Zef; 6 | use Zef::Build; 7 | use Zef::Distribution; 8 | 9 | 10 | subtest 'Zef::Build.build' => { 11 | subtest 'Two builders, first does not match/handle uri' => { 12 | my class Mock::Builder::One does Builder { 13 | method build-matcher(|--> False) { } 14 | 15 | method build($) { die 'should not get called' } 16 | } 17 | 18 | my class Mock::Builder::Two does Builder { 19 | method build-matcher(|--> True) { } 20 | 21 | method build($ --> True) { } 22 | } 23 | 24 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 25 | my $builder = Zef::Build.new but role :: { method plugins(|--> List) { Mock::Builder::One.new, Mock::Builder::Two.new } }; 26 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 27 | ok $builder.build(Candidate.new(:$dist)); 28 | try $save-to.rmdir; 29 | } 30 | 31 | subtest 'Two builders, first not capable of handling given uri' => { 32 | my class Mock::Builder::One does Builder { 33 | method build-matcher(|--> False) { } 34 | 35 | method build($) { die 'should not get called' } 36 | } 37 | 38 | my class Mock::Builder::Two does Builder { 39 | method build-matcher(|--> True) { } 40 | 41 | method build($ --> True) { } 42 | } 43 | 44 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 45 | my $builder = Zef::Build.new but role :: { method plugins(|--> List) { Mock::Builder::One.new, Mock::Builder::Two.new } }; 46 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 47 | ok $builder.build(Candidate.new(:$dist)); 48 | try $save-to.rmdir; 49 | } 50 | 51 | subtest 'Two builders, first fails' => { 52 | my class Mock::Builder::One does Builder { 53 | method build-matcher(|--> True) { } 54 | 55 | method build($ --> Nil) { } 56 | } 57 | 58 | my class Mock::Builder::Two does Builder { 59 | method build-matcher(|--> True) { } 60 | 61 | method build($ --> True) { } 62 | } 63 | 64 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 65 | my $builder = Zef::Build.new but role :: { method plugins(|--> List) { Mock::Builder::One.new, Mock::Builder::Two.new } }; 66 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 67 | ok $builder.build(Candidate.new(:$dist)); 68 | try $save-to.rmdir; 69 | } 70 | 71 | subtest 'Two builders, first times out' => { 72 | my constant timeout = 1; 73 | 74 | my class Mock::Builder::One does Builder { 75 | method build-matcher(|--> True) { } 76 | 77 | method build($) { sleep(timeout * 5); timeout; } 78 | } 79 | 80 | my class Mock::Builder::Two does Builder { 81 | method build-matcher(|--> True) { } 82 | 83 | method build($ --> True) { } 84 | } 85 | 86 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 87 | my $builder = Zef::Build.new but role :: { method plugins(|--> List) { Mock::Builder::One.new, Mock::Builder::Two.new } }; 88 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 89 | ok $builder.build(Candidate.new(:$dist), :timeout(timeout)); 90 | try $save-to.rmdir; 91 | } 92 | } 93 | 94 | 95 | done-testing; -------------------------------------------------------------------------------- /t/test.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 1; 4 | 5 | use Zef; 6 | use Zef::Test; 7 | use Zef::Distribution; 8 | 9 | 10 | subtest 'Zef::Test.test' => { 11 | subtest 'Two testers, first does not match/handle uri' => { 12 | my class Mock::Tester::One does Tester { 13 | method test-matcher(|--> False) { } 14 | 15 | method test($) { die 'should not get called' } 16 | } 17 | 18 | my class Mock::Tester::Two does Tester { 19 | method test-matcher(|--> True) { } 20 | 21 | method test($ --> True) { } 22 | } 23 | 24 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 25 | my $tester = Zef::Test.new but role :: { method plugins(|--> List) { Mock::Tester::One.new, Mock::Tester::Two.new } }; 26 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 27 | ok $tester.test(Candidate.new(:$dist)); 28 | try $save-to.rmdir; 29 | } 30 | 31 | subtest 'Two testers, first not capable of handling given uri' => { 32 | my class Mock::Tester::One does Tester { 33 | method test-matcher(|--> False) { } 34 | 35 | method test($) { die 'should not get called' } 36 | } 37 | 38 | my class Mock::Tester::Two does Tester { 39 | method test-matcher(|--> True) { } 40 | 41 | method test($ --> True) { } 42 | } 43 | 44 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 45 | my $tester = Zef::Test.new but role :: { method plugins(|--> List) { Mock::Tester::One.new, Mock::Tester::Two.new } }; 46 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 47 | ok $tester.test(Candidate.new(:$dist)); 48 | try $save-to.rmdir; 49 | } 50 | 51 | subtest 'Two testers, first fails and second is not tried' => { 52 | my class Mock::Tester::One does Tester { 53 | method test-matcher(|--> True) { } 54 | 55 | method test($ --> Nil) { } 56 | } 57 | 58 | my class Mock::Tester::Two does Tester { 59 | method test-matcher(|--> True) { } 60 | 61 | method test($ --> True) { die 'should not get called' } 62 | } 63 | 64 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 65 | my $tester = Zef::Test.new but role :: { method plugins(|--> List) { Mock::Tester::One.new, Mock::Tester::Two.new } }; 66 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 67 | is $tester.test(Candidate.new(:$dist)).grep(*.so).elems, 0; 68 | try $save-to.rmdir; 69 | } 70 | 71 | subtest 'Two testers, first times out and second is not tried' => { 72 | my constant timeout = 1; 73 | 74 | my class Mock::Tester::One does Tester { 75 | method test-matcher(|--> True) { } 76 | 77 | method test($) { sleep(timeout * 5); timeout; } 78 | } 79 | 80 | my class Mock::Tester::Two does Tester { 81 | method test-matcher(|--> True) { } 82 | 83 | method test($ --> True) { die 'should not get called' } 84 | } 85 | 86 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 87 | my $tester = Zef::Test.new but role :: { method plugins(|--> List) { Mock::Tester::One.new, Mock::Tester::Two.new } }; 88 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 89 | is $tester.test(Candidate.new(:$dist), :timeout(timeout)).grep(*.so).elems, 0; 90 | try $save-to.rmdir; 91 | } 92 | } 93 | 94 | 95 | done-testing; -------------------------------------------------------------------------------- /lib/Zef/Service/InstallRakuDistribution.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | 4 | class Zef::Service::InstallRakuDistribution does Installer { 5 | 6 | =begin pod 7 | 8 | =title class Zef::Service::InstallRakuDistribution 9 | 10 | =subtitle A raku CompUnit::Repository based implementation of the Installer interface 11 | 12 | =head1 Synopsis 13 | 14 | =begin code :lang 15 | 16 | use Zef; 17 | use Zef::Service::InstallRakuDistribution; 18 | 19 | my $installer = Zef::Service::InstallRakuDistribution.new; 20 | 21 | # Add logging if we want to see output 22 | my $stdout = Supplier.new; 23 | my $stderr = Supplier.new; 24 | $stdout.Supply.tap: { say $_ }; 25 | $stderr.Supply.tap: { note $_ }; 26 | 27 | # Assuming our current directory is a raku distribution 28 | # with no dependencies or all dependencies already installed... 29 | my $dist-to-install = Zef::Distribution::Local.new($*CWD); 30 | my $cur = CompUnit::RepositoryRegistry.repository-for-name("site"); # default install location 31 | my $passed = so $installer.install($dist-to-test, :$cur, :$stdout, :$stderr); 32 | say $passed ?? "PASS" !! "FAIL"; 33 | 34 | =end code 35 | 36 | =head1 Description 37 | 38 | C class for handling raku C installation (it installs raku modules). 39 | 40 | You probably never want to use this unless its indirectly through C. 41 | 42 | =head1 Methods 43 | 44 | =head2 method probe 45 | 46 | method probe(--> Bool:D) 47 | 48 | Returns C if this module believes all run time prerequisites are met. Since the only prerequisite 49 | is C<$*EXECUTABLE> this always returns C. 50 | 51 | =head2 method install-matcher 52 | 53 | method install-matcher(Distribution $ --> Bool:D) { return True } 54 | 55 | Returns C if this module knows how to install the given C. 56 | 57 | Note: This always returns C right now, but may not in the future if zef learns how to 58 | install packages from other languages (such as perl via a cpanm wrapper). 59 | 60 | =head2 method install 61 | 62 | method install(Distribution $dist, CompUnit::Repository :$cur, Bool :$force, Bool :$precompile, Supplier $stdout, Suppluer :$stderr --> Bool:D) 63 | 64 | Install the distribution C<$dist> to the CompUnit::Repository C<$cur>. If C<$force> is C 65 | then it will allow reinstalling an already installed distribution. If C<$precompile> is C 66 | then it will not precompile during installation. A C can be supplied as C<:$stdout> 67 | and C<:$stderr> to receive any output. 68 | 69 | Returns C if the install succeeded. 70 | 71 | =end pod 72 | 73 | 74 | #| Always return True since this is using the built-in raku installation logic 75 | method probe(--> Bool:D) { True } 76 | 77 | #| Return true as long as we have a Distribution class that raku knows how to install 78 | method install-matcher(Distribution $ --> Bool:D) { return True } 79 | 80 | #| Install the distribution in $candi.dist to the $cur CompUnit::Repository. 81 | #| Use :force to install over an existing distribution using the same name/auth/ver/api 82 | method install(Distribution $dist, CompUnit::Repository :$cur, Bool :$force, Bool :$precompile, Supplier :$stdout, Supplier :$stderr --> Bool:D) { 83 | $cur.install($dist, :$precompile, :$force); 84 | return True; 85 | } 86 | } 87 | -------------------------------------------------------------------------------- /t/extract.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 1; 4 | 5 | use Zef; 6 | use Zef::Extract; 7 | 8 | 9 | subtest 'Zef::Extract.extract' => { 10 | subtest 'Two extracters, first does not match/handle uri' => { 11 | my class Mock::Extracter::One does Extractor { 12 | method extract-matcher(|--> False) { } 13 | 14 | method extract($, $) { die 'should not get called' } 15 | 16 | method ls-files { } 17 | } 18 | 19 | my class Mock::Extracter::Two does Extractor { 20 | method extract-matcher(|--> True) { } 21 | 22 | method extract($, $to) { $to } 23 | 24 | method ls-files { } 25 | } 26 | 27 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 28 | my $extracter = Zef::Extract.new but role :: { method plugins(|--> List) { Mock::Extracter::One.new, Mock::Extracter::Two.new } }; 29 | is $extracter.extract(Candidate.new(:uri($*CWD)), $save-to.absolute), $save-to.absolute; 30 | try $save-to.rmdir; 31 | } 32 | 33 | subtest 'Two extracters, first not capable of handling given uri' => { 34 | my class Mock::Extracter::One does Extractor { 35 | method extract-matcher(|--> False) { } 36 | 37 | method extract($, $) { die 'should not get called' } 38 | 39 | method ls-files { } 40 | } 41 | 42 | my class Mock::Extracter::Two does Extractor { 43 | method extract-matcher(|--> True) { } 44 | 45 | method extract($, $to) { $to } 46 | 47 | method ls-files { } 48 | } 49 | 50 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 51 | my $extracter = Zef::Extract.new but role :: { method plugins(|--> List) { Mock::Extracter::One.new, Mock::Extracter::Two.new } }; 52 | is $extracter.extract(Candidate.new(:uri($*CWD)), $save-to.absolute), $save-to.absolute; 53 | try $save-to.rmdir; 54 | } 55 | 56 | subtest 'Two extracters, first fails' => { 57 | my class Mock::Extracter::One does Extractor { 58 | method extract-matcher(|--> True) { } 59 | 60 | method extract($, $ --> Nil) { } 61 | 62 | method ls-files { } 63 | } 64 | 65 | my class Mock::Extracter::Two does Extractor { 66 | method extract-matcher(|--> True) { } 67 | 68 | method extract($, $to) { $to } 69 | 70 | method ls-files { } 71 | } 72 | 73 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 74 | my $extracter = Zef::Extract.new but role :: { method plugins(|--> List) { Mock::Extracter::One.new, Mock::Extracter::Two.new } }; 75 | is $extracter.extract(Candidate.new(:uri($*CWD)), $save-to.absolute), $save-to.absolute; 76 | try $save-to.rmdir; 77 | } 78 | 79 | subtest 'Two extracters, first times out' => { 80 | my constant timeout = 1; 81 | 82 | my class Mock::Extracter::One does Extractor { 83 | method extract-matcher(|--> True) { } 84 | 85 | method extract($, $) { sleep(timeout * 5); timeout; } 86 | 87 | method ls-files { } 88 | } 89 | 90 | my class Mock::Extracter::Two does Extractor { 91 | method extract-matcher(|--> True) { } 92 | 93 | method extract($, $to) { $to } 94 | 95 | method ls-files { } 96 | } 97 | 98 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 99 | my $extracter = Zef::Extract.new but role :: { method plugins(|--> List) { Mock::Extracter::One.new, Mock::Extracter::Two.new } }; 100 | is $extracter.extract(Candidate.new(:uri($*CWD)), $save-to.absolute, :timeout(timeout)), $save-to.absolute; 101 | try $save-to.rmdir; 102 | } 103 | } 104 | 105 | 106 | done-testing; -------------------------------------------------------------------------------- /.github/workflows/tests.yml: -------------------------------------------------------------------------------- 1 | name: test 2 | 3 | on: [ push, pull_request ] 4 | 5 | jobs: 6 | raku: 7 | strategy: 8 | fail-fast: false 9 | matrix: 10 | os: [ macos-latest, windows-latest, ubuntu-latest ] 11 | raku-version: [ latest ] 12 | runs-on: ${{ matrix.os }} 13 | 14 | steps: 15 | - uses: actions/checkout@v4 16 | with: 17 | persist-credentials: false 18 | 19 | - uses: Raku/setup-raku@v1 20 | with: 21 | raku-version: ${{ matrix.raku-version }} 22 | 23 | - name: Remove non-core modules included in this github action 24 | run: raku -e 'my $site = CompUnit::RepositoryRegistry.repository-for-name(q|site|); $site.uninstall($_) for $site.installed' 25 | 26 | # run xt/ tests 27 | - name: Run xt/ tests - repository.rakutest 28 | run: raku --ll-exception -I. xt/repository.rakutest 29 | - name: Run xt/ tests - install.rakutest 30 | run: raku --ll-exception -I. xt/install.rakutest 31 | 32 | # run integration tests pre-install 33 | - name: Test (and show for debugging purposes) --version 34 | run: raku -I. bin/zef --version 35 | - name: Run relative local path test + install 36 | run: raku -I. bin/zef --debug install . 37 | - name: Test uninstall 38 | run: raku -I. bin/zef uninstall zef 39 | - name: Run absolute local path test + install 40 | run: raku -I. bin/zef install ${{ github.workspace }} 41 | 42 | # run integration tests post-install 43 | - name: Test 'update' 44 | run: zef update --debug 45 | - name: Test --version 46 | run: zef --version 47 | - name: Test --help 48 | run: zef --help 49 | - name: Test 'locate' with short-name 50 | run: zef locate Zef::CLI 51 | - name: Test 'locate' with path name 52 | run: zef locate lib/Zef/CLI.rakumod 53 | - name: Test 'browse' 54 | run: zef browse zef bugtracker --/open 55 | - name: Test 'info' 56 | run: zef info zef 57 | - name: Test 'search' 58 | run: zef --debug search Base64 59 | - name: Test 'rdepends' 60 | run: zef --debug rdepends Base64 61 | - name: Test 'depends' 62 | run: zef --debug depends Cro::SSL 63 | - name: Test 'fetch' 64 | run: zef --debug fetch Base64 65 | - name: Test installing from what 'fetch' put in ::LocalCache 66 | run: zef --debug --/fez --/cpan --/p6c --/rea install Base64 67 | - name: Test 'list' 68 | run: zef --debug --max=10 list 69 | - name: Test 'list --installed' 70 | run: zef --debug --installed list 71 | - name: Test reinstallation via 'install --force-install' 72 | run: zef --debug --force-install install Base64 73 | - name: Test installing .tar.gz 74 | run: zef --debug install https://github.com/ugexe/Raku-PathTools/archive/0434191c56e0f3254ab1d756d90f9191577de5a0.tar.gz 75 | - name: Test 'upgrade' on previously installed PathTools .tar.gz 76 | run: zef --debug upgrade PathTools 77 | - name: Test installing .zip 78 | run: zef --debug install https://github.com/ugexe/Raku-Text--Table--Simple/archive/v0.0.3.zip 79 | - name: Test remote git repo + tag 80 | run: zef --debug install https://github.com/ugexe/Raku-Text--Table--Simple.git@v0.0.4 81 | - name: Test self contained installation 82 | run: | 83 | zef install Distribution::Common --/test 84 | zef install Distribution::Common::Remote -to=inst#foo --contained --/test 85 | zef uninstall Distribution::Common 86 | raku -I inst#foo -M Distribution::Common::Remote::Github -e "" 87 | - name: Test 'nuke' on config paths 88 | run: zef --/confirm nuke TempDir StoreDir 89 | - name: Test single repository update ('cached' should be 0 after previous nuke) 90 | run: zef update cached --debug 91 | -------------------------------------------------------------------------------- /t/install.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 1; 4 | 5 | use Zef; 6 | use Zef::Install; 7 | use Zef::Distribution; 8 | 9 | my $cur = (class :: does CompUnit::Repository { method need { }; method loaded { }; method id { } }).new; 10 | 11 | subtest 'Zef::Install.install' => { 12 | subtest 'Two installers, first does not match/handle uri' => { 13 | my class Mock::Installer::One does Installer { 14 | method install-matcher(|--> False) { } 15 | 16 | method install($) { die 'should not get called' } 17 | } 18 | 19 | my class Mock::Installer::Two does Installer { 20 | method install-matcher(|--> True) { } 21 | 22 | method install($ --> True) { } 23 | } 24 | 25 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 26 | my $installer = Zef::Install.new but role :: { method plugins(|--> List) { Mock::Installer::One.new, Mock::Installer::Two.new } }; 27 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 28 | ok $installer.install(Candidate.new(:$dist), :$cur); 29 | try $save-to.rmdir; 30 | } 31 | 32 | subtest 'Two installers, first not capable of handling given uri' => { 33 | my class Mock::Installer::One does Installer { 34 | method install-matcher(|--> False) { } 35 | 36 | method install($) { die 'should not get called' } 37 | } 38 | 39 | my class Mock::Installer::Two does Installer { 40 | method install-matcher(|--> True) { } 41 | 42 | method install($ --> True) { } 43 | } 44 | 45 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 46 | my $installer = Zef::Install.new but role :: { method plugins(|--> List) { Mock::Installer::One.new, Mock::Installer::Two.new } }; 47 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 48 | ok $installer.install(Candidate.new(:$dist), :$cur); 49 | try $save-to.rmdir; 50 | } 51 | 52 | subtest 'Two installers, first fails and second is not tried' => { 53 | my class Mock::Installer::One does Installer { 54 | method install-matcher(|--> True) { } 55 | 56 | method install($ --> False) { } 57 | } 58 | 59 | my class Mock::Installer::Two does Installer { 60 | method install-matcher(|--> True) { } 61 | 62 | method install($ --> True) { die 'should not get called' } 63 | } 64 | 65 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 66 | my $installer = Zef::Install.new but role :: { method plugins(|--> List) { Mock::Installer::One.new, Mock::Installer::Two.new } }; 67 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 68 | nok $installer.install(Candidate.new(:$dist), :$cur); 69 | try $save-to.rmdir; 70 | } 71 | 72 | subtest 'Two installers, first times out and second is not tried' => { 73 | my constant timeout = 1; 74 | 75 | my class Mock::Installer::One does Installer { 76 | method install-matcher(|--> True) { } 77 | 78 | method install($) { sleep(timeout * 5); timeout; } 79 | } 80 | 81 | my class Mock::Installer::Two does Installer { 82 | method install-matcher(|--> True) { } 83 | 84 | method install($ --> True) { die 'should not get called' } 85 | } 86 | 87 | my $save-to = $*TMPDIR.child(100000.rand).mkdir; 88 | my $installer = Zef::Install.new but role :: { method plugins(|--> List) { Mock::Installer::One.new, Mock::Installer::Two.new } }; 89 | my $dist = Zef::Distribution.new(:name) but role :: { method path { $save-to } }; 90 | nok $installer.install(Candidate.new(:$dist), :$cur, :timeout(timeout)); 91 | try $save-to.rmdir; 92 | } 93 | } 94 | 95 | 96 | done-testing; -------------------------------------------------------------------------------- /xt/install.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 3; 4 | 5 | use Zef; 6 | use Zef::Client; 7 | use Zef::Utils::FileSystem; 8 | use Zef::Identity; 9 | use Zef::Config; 10 | 11 | 12 | my $path = $*TMPDIR.child("zef").child("{time}.{$*PID}"); 13 | my $dist-dir = $path.child('dist'); 14 | my $sources-dir = $path.child('sources'); 15 | my CompUnit::Repository @cur = CompUnit::RepositoryRegistry\ 16 | .repository-for-spec("inst#{$path.absolute}", :next-repo($*REPO)); 17 | END { try delete-paths($path, :r, :d, :f, :dot) } 18 | 19 | my $guess-path = $?FILE.IO.parent.parent.child('resources/config.json'); 20 | my $config-file = $guess-path.e ?? ~$guess-path !! Zef::Config::guess-path(); 21 | my $config = Zef::Config::parse-file($config-file); 22 | $config = "$path/.cache/store"; 23 | $config = "$path/.cache/tmp"; 24 | 25 | my @installed; # keep track of what gets installed for the optional uninstall test at the end 26 | 27 | 28 | my $client = Zef::Client.new(:$config); 29 | # Keeps every $client.install from printing to stdout 30 | sub test-install($path = $?FILE.IO.parent.parent) { 31 | # Need to remove all stdout/stderr output from Zef::Client, or at least complete 32 | # the message passing mechanism so it can be turned off at will. Until then just 33 | # turn off stdout for this test as it will output details to stdout even when !$verbose) 34 | temp $*OUT = class :: { method print(|) {}; method flush(|) {}; }; 35 | # No test distribution to install yet, so test install zef itself 36 | my $candidate = Candidate.new( 37 | dist => Zef::Distribution::Local.new($path), 38 | uri => $path.IO.absolute, 39 | as => ~$path, 40 | from => ~$?FILE, 41 | ); 42 | my @got = |$client.make-install( :to(@cur), :!test, :!fetch, $candidate ); 43 | @installed = unique(|@installed, |@got, :as(*.dist.identity)); 44 | } 45 | 46 | 47 | ######################################################################################### 48 | 49 | 50 | subtest 'install' => { 51 | my @installed = test-install(); 52 | 53 | is +@installed, 1, 'Installed a single module'; 54 | is +$dist-dir.dir.grep(*.f), 1, 'A single distribution file should exist'; 55 | 56 | # $dist-info is the content of a file that holds meta information, such as 57 | # the new names of the files. If ~$filename from $sources-dir is found in 58 | # ~$dist-info then just assume everything worked correctly 59 | my $filename = $sources-dir.dir.first(*.f).basename; 60 | my $dist-info = $dist-dir.dir.first(*.f).slurp; 61 | ok $dist-info.contains($filename), 'Verify install succeeded'; 62 | } 63 | 64 | 65 | subtest 'reinstall' => { 66 | subtest 'Without force' => { 67 | test-install(); # XXX: Need to find a way to test when this fails 68 | is +@installed, 1, 'Installed nothing new'; 69 | is +$dist-dir.dir.grep(*.f), 1, 'Only a single distribution file should still exist'; 70 | my $filename = $sources-dir.dir.first(*.f).basename; 71 | my $dist-info = $dist-dir.dir.first(*.f).slurp; 72 | ok $dist-info.contains($filename), 'Verify previous install appears valid'; 73 | } 74 | 75 | subtest 'With force-install' => { 76 | temp $client.force-install = True; 77 | my @installed = test-install(); 78 | 79 | is +@installed, 1, 'Install count remains 1'; 80 | is +$dist-dir.dir.grep(*.f), 1, 'Only a single distribution file should still exist'; 81 | my $filename = ~$sources-dir.dir.first(*.f).basename; 82 | my $dist-info = ~$dist-dir.dir.first(*.f).slurp; 83 | ok $dist-info.contains($filename), 'Verify reinstall appears valid'; 84 | } 85 | } 86 | 87 | 88 | subtest 'uninstall' => { 89 | +@cur.grep(*.can('uninstall')) == 0 90 | ?? skip("Need a newer rakudo for uninstall") 91 | !! do { 92 | my @uninstalled = Zef::Client.new(:$config).uninstall( :from(@cur), |@installed>>.dist>>.identity ); 93 | is +@uninstalled, 1, 'Uninstalled a single module'; 94 | is +$sources-dir.dir, 0, 'No source files should remain'; 95 | is +$dist-dir.dir, 0, 'No distribution files should remain'; 96 | } 97 | } 98 | 99 | 100 | done-testing; -------------------------------------------------------------------------------- /lib/Zef/Service/Shell/Test.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Utils::FileSystem:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | class Zef::Service::Shell::Test does Tester { 6 | 7 | =begin pod 8 | 9 | =title class Zef::Service::Shell::Test 10 | 11 | =subtitle A raku executable based implementation of the Tester interface 12 | 13 | =head1 Synopsis 14 | 15 | =begin code :lang 16 | 17 | use Zef; 18 | use Zef::Service::Shell::Test; 19 | 20 | my $test = Zef::Service::Shell::Test.new; 21 | 22 | # Add logging if we want to see output 23 | my $stdout = Supplier.new; 24 | my $stderr = Supplier.new; 25 | $stdout.Supply.tap: { say $_ }; 26 | $stderr.Supply.tap: { note $_ }; 27 | 28 | # Assuming our current directory is a raku distribution 29 | # with no dependencies or all dependencies already installed... 30 | my $dist-to-test = $*CWD; 31 | my Str @includes = $*CWD.absolute; 32 | my $passed = so $test.test($dist-to-test, :@includes, :$stdout, :$stderr); 33 | say $passed ?? "PASS" !! "FAIL"; 34 | 35 | =end code 36 | 37 | =head1 Description 38 | 39 | C class for handling path based URIs ending in .rakutest / .t6 / .t using the C command. 40 | 41 | You probably never want to use this unless its indirectly through C; 42 | handling files and spawning processes will generally be easier using core language functionality. This 43 | class exists to provide the means for fetching a file using the C interfaces that the e.g. Test/TAP 44 | adapters use. 45 | 46 | =head1 Methods 47 | 48 | =head2 method probe 49 | 50 | method probe(--> Bool:D) 51 | 52 | Returns C if this module can successfully launch the C command (i.e. always returns C). 53 | 54 | =head2 method test-matcher 55 | 56 | method test-matcher(Str() :uri($) --> Bool:D) 57 | 58 | Returns C if this module knows how to test C<$uri>. This module always returns C right now since 59 | it just launches tests directly with the C command. 60 | 61 | =head2 method test 62 | 63 | method test(IO() $path, Str :@includes, Supplier :$stdout, Supplier :$stderr --> Bool:D) 64 | 65 | Test the files ending in C<.rakutest> C<.t6> or C<.t> in the C directory of the given C<$path> using the 66 | provided C<@includes> (e.g. C or C) via the C command. A C can be 67 | supplied as C<:$stdout> and C<:$stderr> to receive any output. 68 | 69 | Returns C if all test files exited with 0. 70 | 71 | =end pod 72 | 73 | 74 | #| Returns true always since it just uses $*EXECUTABLE 75 | method probe(--> Bool:D) { True } 76 | 77 | #| Return true if this Tester understands the given uri/path 78 | method test-matcher(Str() $ --> Bool:D) { return True } 79 | 80 | #| Test the given paths t/ directory using any provided @includes 81 | method test(IO() $path, :@includes, Supplier :$stdout, Supplier :$stderr --> Bool:D) { 82 | die "path does not exist: {$path}" unless $path.IO.e; 83 | my $test-path = $path.child('t'); 84 | return True unless $test-path.e; 85 | 86 | my @rel-test-files = sort 87 | map *.IO.relative($path), 88 | grep *.extension eq any('rakutest', 't', 't6'), 89 | list-paths($test-path.absolute, :f, :!d, :r); 90 | return True unless +@rel-test-files; 91 | 92 | my @results = @rel-test-files.map: -> $rel-test-file { 93 | my $passed; 94 | react { 95 | my $proc = Zef::zrun-async($*EXECUTABLE.absolute, @includes.map({ slip '-I', $_ }), $rel-test-file); 96 | $stdout.emit("Command: {$proc.command}"); 97 | whenever $proc.stdout.lines { $stdout.emit($_) } 98 | whenever $proc.stderr.lines { $stderr.emit($_) } 99 | whenever $proc.start(:cwd($path)) { $passed = $_.so } 100 | } 101 | $passed; 102 | } 103 | 104 | return so @results.all; 105 | } 106 | } 107 | -------------------------------------------------------------------------------- /lib/Zef/Service/Shell/wget.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | 4 | class Zef::Service::Shell::wget does Fetcher does Probeable { 5 | 6 | =begin pod 7 | 8 | =title class Zef::Service::Shell::wget 9 | 10 | =subtitle A wget based implementation of the Fetcher interface 11 | 12 | =head1 Synopsis 13 | 14 | =begin code :lang 15 | 16 | use Zef; 17 | use Zef::Service::Shell::wget; 18 | 19 | my $wget = Zef::Service::Shell::wget.new; 20 | 21 | my $source = "https://raw.githubusercontent.com/ugexe/zef/main/META6.json"; 22 | my $save-to = $*TMPDIR.child("zef-meta6.json"); 23 | my $saved-to = $wget.fetch($source, $save-to); 24 | 25 | die "Something went wrong" unless $saved-to; 26 | say "Zef META6 from HEAD: "; 27 | say $saved-to.slurp; 28 | 29 | =end code 30 | 31 | =head1 Description 32 | 33 | C class for handling http based URIs using the C command. 34 | 35 | You probably never want to use this unless its indirectly through C; 36 | handling files and spawning processes will generally be easier using core language functionality. This 37 | class exists to provide the means for fetching a file using the C interfaces that the e.g. git/file 38 | adapters use. 39 | 40 | =head1 Methods 41 | 42 | =head2 method probe 43 | 44 | method probe(--> Bool:D) 45 | 46 | Returns C if this module can successfully launch the C command. 47 | 48 | =head2 method fetch-matcher 49 | 50 | method fetch-matcher(Str() $uri --> Bool:D) 51 | 52 | Returns C if this module knows how to fetch C<$uri>, which it decides based on if C<$uri> 53 | starts with C or C. 54 | 55 | =head2 method fetch 56 | 57 | method fetch(Str() $uri, IO() $save-as, Supplier :$stdout, Supplier :$stderr --> IO::Path) 58 | 59 | Fetches the given C<$uri>, saving it to C<$save-to>. A C can be supplied as C<:$stdout> and 60 | C<:$stderr> to receive any output. 61 | 62 | On success it returns the C where the data was actually saved to. On failure it returns C. 63 | 64 | =end pod 65 | 66 | my Str $command-cache; 67 | my Lock $command-lock = Lock.new; 68 | 69 | method !command { 70 | $command-lock.protect: { 71 | return $command-cache if $command-cache.defined; 72 | if BEGIN { $*DISTRO.is-win } && try so Zef::zrun('wget.exe', '--help', :!out, :!err) { 73 | # When running under powershell we don't want to use the wget Invoke-WebRequest 74 | # alias so explicitly add the .exe 75 | return $command-cache = 'wget.exe'; 76 | } 77 | return $command-cache = 'wget'; 78 | } 79 | } 80 | 81 | my Lock $probe-lock = Lock.new; 82 | my Bool $probe-cache; 83 | 84 | #| Return true if the `curl` command is available to use 85 | method probe(--> Bool:D) { 86 | $probe-lock.protect: { 87 | return $probe-cache if $probe-cache.defined; 88 | my $command = self!command(); 89 | my $probe is default(False) = try so Zef::zrun($command, '--help', :!out, :!err); 90 | return $probe-cache = $probe; 91 | } 92 | } 93 | 94 | #| Return true if this Fetcher understands the given uri/path 95 | method fetch-matcher(Str() $uri --> Bool:D) { 96 | return so .first({ $uri.lc.starts-with($_) }); 97 | } 98 | 99 | #| Fetch the given url 100 | method fetch(Str() $uri, IO() $save-as, Supplier :$stdout, Supplier :$stderr --> IO::Path) { 101 | die "target download directory {$save-as.parent} does not exist and could not be created" 102 | unless $save-as.parent.d || mkdir($save-as.parent); 103 | 104 | my $passed; 105 | react { 106 | my $cwd := $save-as.parent; 107 | my $ENV := %*ENV; 108 | my $cmd := self!command(); 109 | my $proc = Zef::zrun-async($cmd, '-P', $cwd, '--quiet', $uri, '-O', $save-as.absolute); 110 | $stdout.emit("Command: {$proc.command}"); 111 | whenever $proc.stdout(:bin) { } 112 | whenever $proc.stderr(:bin) { } 113 | whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } 114 | } 115 | 116 | return ($passed && $save-as.e) ?? $save-as !! Nil; 117 | } 118 | } 119 | -------------------------------------------------------------------------------- /lib/Zef/Service/Shell/curl.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | 4 | class Zef::Service::Shell::curl does Fetcher does Probeable { 5 | 6 | =begin pod 7 | 8 | =title class Zef::Service::Shell::curl 9 | 10 | =subtitle A curl based implementation of the Fetcher interface 11 | 12 | =head1 Synopsis 13 | 14 | =begin code :lang 15 | 16 | use Zef; 17 | use Zef::Service::Shell::curl; 18 | 19 | my $curl = Zef::Service::Shell::curl.new; 20 | 21 | my $source = "https://raw.githubusercontent.com/ugexe/zef/main/META6.json"; 22 | my $save-to = $*TMPDIR.child("zef-meta6.json"); 23 | my $saved-to = $curl.fetch($source, $save-to); 24 | 25 | die "Something went wrong" unless $saved-to; 26 | say "Zef META6 from HEAD: "; 27 | say $saved-to.slurp; 28 | 29 | =end code 30 | 31 | =head1 Description 32 | 33 | C class for handling http based URIs using the C command. 34 | 35 | You probably never want to use this unless its indirectly through C; 36 | handling files and spawning processes will generally be easier using core language functionality. This 37 | class exists to provide the means for fetching a file using the C interfaces that the e.g. git/file 38 | adapters use. 39 | 40 | =head1 Methods 41 | 42 | =head2 method probe 43 | 44 | method probe(--> Bool:D) 45 | 46 | Returns C if this module can successfully launch the C command. 47 | 48 | =head2 method fetch-matcher 49 | 50 | method fetch-matcher(Str() $uri --> Bool:D) 51 | 52 | Returns C if this module knows how to fetch C<$uri>, which it decides based on if C<$uri> 53 | starts with C or C. 54 | 55 | =head2 method fetch 56 | 57 | method fetch(Str() $uri, IO() $save-as, Supplier :$stdout, Supplier :$stderr --> IO::Path) 58 | 59 | Fetches the given C<$uri>, saving it to C<$save-to>. A C can be supplied as C<:$stdout> and 60 | C<:$stderr> to receive any output. 61 | 62 | On success it returns the C where the data was actually saved to. On failure it returns C. 63 | 64 | =end pod 65 | 66 | my Str $command-cache; 67 | my Lock $command-lock = Lock.new; 68 | 69 | method !command { 70 | $command-lock.protect: { 71 | return $command-cache if $command-cache.defined; 72 | if BEGIN { $*DISTRO.is-win } && try so Zef::zrun('curl.exe', '--help', :!out, :!err) { 73 | # When running under powershell we don't want to use the curl Invoke-WebRequest 74 | # alias so explicitly add the .exe 75 | return $command-cache = 'curl.exe'; 76 | } 77 | return $command-cache = 'curl'; 78 | } 79 | } 80 | 81 | my Lock $probe-lock = Lock.new; 82 | my Bool $probe-cache; 83 | 84 | #| Return true if the `curl` command is available to use 85 | method probe(--> Bool:D) { 86 | $probe-lock.protect: { 87 | return $probe-cache if $probe-cache.defined; 88 | my $command = self!command(); 89 | my $probe is default(False) = try so Zef::zrun($command, '--help', :!out, :!err); 90 | return $probe-cache = $probe; 91 | } 92 | } 93 | 94 | #| Return true if this Fetcher understands the given uri/path 95 | method fetch-matcher(Str() $uri --> Bool:D) { 96 | return so .first({ $uri.lc.starts-with($_) }); 97 | } 98 | 99 | #| Fetch the given url 100 | method fetch(Str() $uri, IO() $save-as, Supplier :$stdout, Supplier :$stderr --> IO::Path) { 101 | die "target download directory {$save-as.parent} does not exist and could not be created" 102 | unless $save-as.parent.d || mkdir($save-as.parent); 103 | 104 | my $passed; 105 | react { 106 | my $cwd := $save-as.parent; 107 | my $ENV := %*ENV; 108 | my $cmd := self!command(); 109 | my $proc = Zef::zrun-async($cmd, '--silent', '-L', '-z', $save-as.absolute, '-o', $save-as.absolute, $uri); 110 | $stdout.emit("Command: {$proc.command}"); 111 | whenever $proc.stdout(:bin) { } 112 | whenever $proc.stderr(:bin) { } 113 | whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } 114 | } 115 | 116 | return ($passed && $save-as.e) ?? $save-as !! Nil; 117 | } 118 | } 119 | -------------------------------------------------------------------------------- /lib/Zef/Service/Shell/LegacyBuild.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Distribution::Local:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | class Zef::Service::Shell::LegacyBuild does Builder { 6 | 7 | =begin pod 8 | 9 | =title class Zef::Service::Shell::LegacyBuild 10 | 11 | =subtitle A raku based implementation of the Builder interface 12 | 13 | =head1 Synopsis 14 | 15 | =begin code :lang 16 | 17 | use Zef; 18 | use Zef::Service::Shell::LegacyBuild; 19 | 20 | my $builder = Zef::Service::Shell::LegacyBuild.new; 21 | 22 | # Add logging if we want to see output 23 | my $stdout = Supplier.new; 24 | my $stderr = Supplier.new; 25 | $stdout.Supply.tap: { say $_ }; 26 | $stderr.Supply.tap: { note $_ }; 27 | 28 | # Assuming our current directory is a raku distribution with a 29 | # Build.rakumod and has no dependencies (or all dependencies 30 | # already installed)... 31 | my $dist-to-build = Zef::Distribution::Local.new($*CWD); 32 | my Str @includes = $*CWD.absolute; 33 | my $built-ok = so $builder.build($dist-to-build, :@includes, :$stdout, :$stderr); 34 | say $built-ok ?? "OK" !! "Something went wrong"; 35 | 36 | =end code 37 | 38 | =head1 Description 39 | 40 | C class for handling local distributions that include a .rakumod / .pm6 / .pm alongside their C. 41 | Launches an e.g. 'Build.rakumod' file of the provided distribution with the raku executable. 42 | 43 | Note: These type of build files will be deprecated one day in the (possibly far) future. Prefer build tools like 44 | C (which uses C) if possible. 45 | 46 | =head1 Methods 47 | 48 | =head2 method probe 49 | 50 | method probe(--> Bool:D) 51 | 52 | Returns C if this module can successfully launch the C command (i.e. always returns C). 53 | 54 | =head2 method build-matcher 55 | 56 | method build-matcher(Zef::Distribution::Local $dist --> Bool:D) 57 | 58 | Returns C if this module knows how to test C<$uri>, which it decides based on if the files extracted from 59 | C<$dist> contains any of C C or C (must be extracted as these do not get declared 60 | in a META6.json file). 61 | 62 | =head2 method build 63 | 64 | method build(Zef::Distribution::Local $dist, Str :@includes, Supplier :$stdout, Supplier :$stderr --> Bool:D) 65 | 66 | Launch the e.g. C module in the root directory of an extracted C<$dist> using the provided C<@includes> 67 | (e.g. C or C) via the C command (essentially doing C<::(Build).new.build($dist-dir)>). 68 | A C can be supplied as C<:$stdout> and C<:$stderr> to receive any output. 69 | 70 | Returns C if the C process spawned to run the build module exits 0. 71 | 72 | =end pod 73 | 74 | 75 | #| Get the path of the Build file that will be executed 76 | method !guess-build-file(IO() $prefix --> IO::Path) { return .map({ $prefix.child($_) }).first({ $_.e }) } 77 | 78 | #| Return true always since it just requires launching another raku process 79 | method probe(--> Bool:D) { True } 80 | 81 | #| Return true if this Builder understands the given uri/path of the provided distribution 82 | method build-matcher(Zef::Distribution::Local $dist --> Bool:D) { return so self!guess-build-file($dist.path) } 83 | 84 | #| Run the Build.rakumod of the given distribution 85 | method build(Zef::Distribution::Local $dist, Str :@includes, Supplier :$stdout, Supplier :$stderr --> Bool:D) { 86 | die "path does not exist: {$dist.path}" unless $dist.path.IO.e; 87 | 88 | my $build-file = self!guess-build-file($dist.path).absolute; 89 | my $cmd = "require '$build-file'; ::('Build').new.build('$dist.path.IO.absolute()') ?? exit(0) !! exit(1);"; 90 | my @exec = |($*EXECUTABLE.absolute, |@includes.grep(*.defined).map({ "-I{$_}" }), '-e', "$cmd"); 91 | 92 | my $ENV := %*ENV; 93 | my $passed; 94 | react { 95 | my $proc = Zef::zrun-async(@exec); 96 | $stdout.emit("Command: {$proc.command}"); 97 | whenever $proc.stdout.lines { $stdout.emit($_) } 98 | whenever $proc.stderr.lines { $stderr.emit($_) } 99 | whenever $proc.start(:$ENV, :cwd($dist.path)) { $passed = $_.so } 100 | } 101 | return $passed; 102 | } 103 | } 104 | -------------------------------------------------------------------------------- /lib/Zef/Service/TAP.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Utils::FileSystem:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | class Zef::Service::TAP does Tester { 6 | 7 | =begin pod 8 | 9 | =title class Zef::Service::TAP 10 | 11 | =subtitle A TAP module based implementation of the Tester interface 12 | 13 | =head1 Synopsis 14 | 15 | =begin code :lang 16 | 17 | use Zef; 18 | use Zef::Service::TAP; 19 | 20 | my $tap = Zef::Service::TAP.new; 21 | 22 | # Add logging if we want to see output 23 | my $stdout = Supplier.new; 24 | my $stderr = Supplier.new; 25 | $stdout.Supply.tap: { say $_ }; 26 | $stderr.Supply.tap: { note $_ }; 27 | 28 | # Assuming our current directory is a raku distribution 29 | # with no dependencies or all dependencies already installed... 30 | my $dist-to-test = $*CWD; 31 | my Str @includes = $*CWD.absolute; 32 | my $passed = so $tap.test($dist-to-test, :@includes, :$stdout, :$stderr); 33 | say $passed ?? "PASS" !! "FAIL"; 34 | 35 | =end code 36 | 37 | =head1 Description 38 | 39 | C class for handling path based URIs ending in .rakutest / .t6 / .t using the raku C module. 40 | 41 | You probably never want to use this unless its indirectly through C; 42 | handling files and spawning processes will generally be easier using core language functionality. This 43 | class exists to provide the means for fetching a file using the C interfaces that the e.g. Test 44 | adapter uses. 45 | 46 | =head1 Methods 47 | 48 | =head2 method probe 49 | 50 | method probe(--> Bool:D) 51 | 52 | Returns C if this module can successfully load the C module. 53 | 54 | =head2 method test-matcher 55 | 56 | method test-matcher(Str() $uri --> Bool:D) 57 | 58 | Returns C if this module knows how to test C<$uri>, which it decides based on if C<$uri> exists 59 | on local file system. 60 | 61 | =head2 method test 62 | 63 | method test(IO() $path, Str :@includes, Supplier :$stdout, Supplier :$stderr --> Bool:D) 64 | 65 | Test the files ending in C<.rakutest> C<.t6> or C<.t> in the C directory of the given C<$path> using the 66 | provided C<@includes> (e.g. C or C) via the C raku module. A C can be 67 | supplied as C<:$stdout> and C<:$stderr> to receive any output. 68 | 69 | Returns C if there were no failed tests and no errors according to C. 70 | 71 | =end pod 72 | 73 | my Lock $probe-lock = Lock.new; 74 | my Bool $probe-cache; 75 | 76 | #| Return true if the `TAP` raku module is available 77 | method probe(--> Bool:D) { 78 | $probe-lock.protect: { 79 | return $probe-cache if $probe-cache.defined; 80 | my $probe = self!has-correct-tap-version && (try require ::('TAP')) !~~ Nil; 81 | return $probe-cache = $probe; 82 | } 83 | } 84 | 85 | method !has-correct-tap-version(--> Bool:D) { 86 | # 0.3.1 has fixed support for :err and added support for :output 87 | return so $*REPO.resolve(CompUnit::DependencySpecification.new( 88 | short-name => 'TAP', 89 | version-matcher => '0.3.5+', 90 | )); 91 | } 92 | 93 | #| Return true if this Tester understands the given uri/path 94 | method test-matcher(Str() $uri --> Bool:D) { return $uri.IO.e } 95 | 96 | #| Test the given paths t/ directory using any provided @includes 97 | method test(IO() $path, Str :@includes, Supplier :$stdout, Supplier :$stderr --> Bool:D) { 98 | die "path does not exist: {$path}" unless $path.e; 99 | 100 | my $test-path = $path.child('t'); 101 | return True unless $test-path.e; 102 | my @test-files = grep *.extension eq any('rakutest', 't', 't6'), 103 | list-paths($test-path.absolute, :f, :!d, :r).sort; 104 | return True unless +@test-files; 105 | 106 | my $result = try { 107 | require ::('TAP'); 108 | my @incdirs = @includes; 109 | my @handlers = ::("TAP::Harness::SourceHandler::Raku").new(:@incdirs); 110 | my $parser = ::("TAP::Harness").new(:@handlers); 111 | my $promise = $parser.run( 112 | @test-files.map(*.relative($path)), 113 | :cwd($path), 114 | :out($stdout), 115 | :err($stderr), 116 | ); 117 | $promise.result; 118 | } 119 | 120 | my $passed = $result.failed == 0 && not $result.errors ?? True !! False; 121 | return $passed; 122 | } 123 | } 124 | -------------------------------------------------------------------------------- /xt/repository.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 5; 4 | 5 | use Zef; 6 | use Zef::Repository; 7 | use Zef::Repository::Ecosystems; 8 | use Zef::Fetch; 9 | 10 | 11 | subtest 'Repository' => { 12 | class Mock::Repository does PackageRepository { 13 | method search(*@identities) { 14 | my Candidate @candidates = 15 | Candidate.new(:as("{@identities[0]}::X")), 16 | Candidate.new(:as("{@identities[0]}::XX")); 17 | return @candidates; 18 | } 19 | } 20 | 21 | subtest 'Mock::Repository' => { 22 | my $mock-repository = Mock::Repository.new; 23 | my @candidates = $mock-repository.search("Mock::Repository"); 24 | 25 | is +@candidates, 2; 26 | is @candidates[0].as, "Mock::Repository::X"; 27 | is @candidates[1].as, "Mock::Repository::XX"; 28 | } 29 | 30 | subtest 'Zef::Repository service aggregation' => { 31 | my $mock-repository1 = Mock::Repository.new; 32 | my $mock-repository2 = Mock::Repository.new; 33 | my $repository = Zef::Repository.new but role :: { 34 | method plugins { [[$mock-repository1, $mock-repository2],] } 35 | } 36 | my @candidates = $repository.search("Mock::Repository"); 37 | is +@candidates, 4; 38 | is @candidates[0].as, "Mock::Repository::X"; 39 | is @candidates[1].as, "Mock::Repository::XX"; 40 | is @candidates[2].as, "Mock::Repository::X"; 41 | is @candidates[3].as, "Mock::Repository::XX"; 42 | } 43 | } 44 | 45 | 46 | subtest 'Ecosystems => p6c' => { 47 | my $wanted = 'zef'; 48 | my @mirrors = 'https://github.com/ugexe/Perl6-ecosystems.git'; 49 | my @backends = [ 50 | { module => "Zef::Service::Shell::git" }, 51 | { module => "Zef::Service::Shell::wget" }, 52 | { module => "Zef::Service::Shell::curl" }, 53 | ]; 54 | 55 | my $fetcher = Zef::Fetch.new(:@backends); 56 | my $cache = $*HOME.child('.zef/store') andthen { mkdir $_ unless $_.IO.e }; 57 | my $p6c = Zef::Repository::Ecosystems.new(name => 'p6c', :$fetcher, :$cache, :auto-update, :@mirrors); 58 | ok $p6c.available > 0; 59 | 60 | subtest 'search' => { 61 | my @candidates = $p6c.search($wanted, :strict); 62 | ok +@candidates > 0; 63 | is @candidates.grep({ .dist.name ne $wanted }).elems, 0; 64 | } 65 | } 66 | 67 | 68 | subtest 'Ecosystems => cpan' => { 69 | my $wanted = 'zef'; 70 | my @mirrors = 'https://raw.githubusercontent.com/ugexe/Perl6-ecosystems/11efd9077b398df3766eaa7cf8e6a9519f63c272/cpan.json'; 71 | my @backends = [ 72 | { module => "Zef::Service::Shell::wget" }, 73 | { module => "Zef::Service::Shell::curl" }, 74 | ]; 75 | 76 | my $fetcher = Zef::Fetch.new(:@backends); 77 | my $cache = $*HOME.child('.zef/store') andthen { mkdir $_ unless $_.IO.e }; 78 | my $cpan = Zef::Repository::Ecosystems.new(name => 'cpan', :$fetcher, :$cache, :auto-update, :@mirrors); 79 | ok $cpan.available > 0; 80 | 81 | subtest 'search' => { 82 | my @candidates = $cpan.search($wanted, :strict); 83 | ok +@candidates > 0; 84 | is @candidates.grep({ .dist.name ne $wanted }).elems, 0; 85 | } 86 | } 87 | 88 | 89 | subtest 'Ecosystems => fez' => { 90 | my $wanted = 'fez'; 91 | my @mirrors = 'http://360.zef.pm/'; 92 | my @backends = [ 93 | { module => "Zef::Service::Shell::wget" }, 94 | { module => "Zef::Service::Shell::curl" }, 95 | ]; 96 | 97 | my $fetcher = Zef::Fetch.new(:@backends); 98 | my $cache = $*HOME.child('.zef/store') andthen { mkdir $_ unless $_.IO.e }; 99 | my $fez = Zef::Repository::Ecosystems.new(name => 'fez', :$fetcher, :$cache, :auto-update, :@mirrors); 100 | ok $fez.available > 0; 101 | 102 | subtest 'search' => { 103 | my @candidates = $fez.search($wanted, :strict); 104 | ok +@candidates > 0; 105 | is @candidates.grep({ .dist.name ne $wanted }).elems, 0; 106 | } 107 | } 108 | 109 | 110 | subtest 'Ecosystems => rea' => { 111 | my $wanted = 'zef'; 112 | my @mirrors = 'https://raw.githubusercontent.com/Raku/REA/main/META.json'; 113 | my @backends = [ 114 | { module => "Zef::Service::Shell::wget" }, 115 | { module => "Zef::Service::Shell::curl" }, 116 | ]; 117 | 118 | my $fetcher = Zef::Fetch.new(:@backends); 119 | my $cache = $*HOME.child('.zef/store') andthen { mkdir $_ unless $_.IO.e }; 120 | my $rea = Zef::Repository::Ecosystems.new(name => 'rea', :$fetcher, :$cache, :auto-update, :@mirrors); 121 | ok $rea.available > 0; 122 | 123 | subtest 'search' => { 124 | my @candidates = $rea.search($wanted, :strict); 125 | ok +@candidates > 0; 126 | is @candidates.grep({ .dist.name ne $wanted }).elems, 0; 127 | } 128 | } 129 | 130 | done-testing; 131 | -------------------------------------------------------------------------------- /lib/Zef/Distribution/DependencySpecification.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Identity:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | role DependencySpecification { 6 | method name(--> Str) { ... } 7 | method identity(--> Str) { ... } 8 | method spec-matcher($spec --> Bool:D) { ... } 9 | } 10 | 11 | class Zef::Distribution::DependencySpecification::Any does DependencySpecification { 12 | has @.specs; 13 | method name { "any({@.specs.map(*.name).join(', ')})" } 14 | method identity { "any({@.specs.map(*.identity).join(',')})" } 15 | method spec-matcher($spec --> Bool:D) { 16 | return so @!specs.first(*.spec-matcher($spec)); 17 | } 18 | } 19 | 20 | class Zef::Distribution::DependencySpecification does DependencySpecification { 21 | has $!ident; 22 | has $.spec; 23 | 24 | submethod TWEAK(:$!spec, :$!ident) { } 25 | multi submethod new(Zef::Identity $ident) { self.bless(:$ident) } 26 | multi submethod new(Str $spec) { self.bless(:$spec) } 27 | multi submethod new(Hash $spec) { self.bless(:$spec) } 28 | multi submethod new(Hash $spec where {$_.keys == 1 and $_.keys[0] eq 'any'}) { 29 | Zef::Distribution::DependencySpecification::Any.new: :specs( 30 | $spec.values[0].map: {self.new($_)} 31 | ) 32 | } 33 | multi submethod new($spec) { 34 | die "Invalid dependency specification: $spec.gist()"; 35 | } 36 | 37 | method identity { 38 | my $hash = %(:name($.name), :ver($.version-matcher), :auth($.auth-matcher), :api($.api-matcher), :from($.from-matcher)); 39 | my $identity = hash2identity( $hash ); 40 | $identity; 41 | } 42 | 43 | method clone(|) { $!ident = Nil; nextsame(); } 44 | 45 | method spec-parts(Zef::Distribution::DependencySpecification:_: $spec = self!spec) { 46 | # Need to find a way to break this cache when a distribution gets cloned with a different version 47 | $!ident //= Zef::Identity.new(|$spec); 48 | $!ident.?hash; 49 | } 50 | 51 | method name { self.spec-parts } 52 | 53 | method ver { self.spec-parts } 54 | 55 | method version-matcher { self.spec-parts // '*' } 56 | 57 | method auth-matcher { self.spec-parts // '' } 58 | 59 | method api-matcher { self.spec-parts // '*' } 60 | 61 | method from-matcher { self.spec-parts // '' } 62 | 63 | method !spec { $.spec || self.Str } 64 | 65 | multi method spec-matcher(Zef::Distribution::DependencySpecification::Any $spec, Bool :$strict = True) { 66 | self.spec-matcher(any($spec.specs), :$strict) 67 | } 68 | 69 | multi method spec-matcher($spec, Bool :$strict = True) { 70 | return False unless $spec.name.?chars && self.name.?chars; 71 | if $strict { 72 | return False unless $spec.name eq self.name; 73 | } 74 | else { 75 | my $name = $spec.name; 76 | return False unless self.name ~~ /[:i $name]/; 77 | } 78 | 79 | if $spec.auth-matcher.chars { 80 | return False unless $.auth-matcher.chars && $spec.auth-matcher eq $.auth-matcher; 81 | } 82 | 83 | if $spec.version-matcher.chars && $spec.version-matcher ne '*' && $.version-matcher ne '*' { 84 | my $spec-version = Version.new($spec.version-matcher); 85 | my $self-version = Version.new($.version-matcher); 86 | return False unless self!version-matcher(:$spec-version, :$self-version); 87 | } 88 | 89 | if $spec.api-matcher.chars && $spec.api-matcher ne '*' && $.api-matcher ne '*' { 90 | my $spec-version = Version.new($spec.api-matcher); 91 | my $self-version = Version.new($.api-matcher); 92 | return False unless self!version-matcher(:$spec-version, :$self-version); 93 | } 94 | 95 | return True; 96 | } 97 | 98 | method !version-matcher(Version :$self-version is copy, Version :$spec-version is copy) { 99 | # Normalize the parts between version so that Version ~~ Version works in the way we need 100 | # Example: for `0.1 ~~ 0.1.1` we want `0.1.0` ~~ `0.1.1` 101 | my $self-add-parts = $spec-version.parts.elems - $self-version.parts.elems; 102 | $self-version = Version.new( (|$self-version.parts, |(0 xx $self-add-parts), ("+" if $self-version.plus)).join('.') ) 103 | if $self-add-parts > 0; 104 | my $spec-add-parts = $self-version.parts.elems - $spec-version.parts.elems; 105 | $spec-version = Version.new( (|$spec-version.parts, |(0 xx $spec-add-parts), ("+" if $spec-version.plus)).join('.') ) 106 | if $spec-add-parts; 107 | 108 | return $self-version ~~ $spec-version; 109 | } 110 | } 111 | -------------------------------------------------------------------------------- /lib/Zef/Service/FileReporter.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | 4 | class Zef::Service::FileReporter does Reporter { 5 | 6 | =begin pod 7 | 8 | =title class Zef::Service::FileReporter 9 | 10 | =subtitle A basic save-to-file based implementation of the Reporter interface 11 | 12 | =head1 Synopsis 13 | 14 | =begin code :lang 15 | 16 | use Zef; 17 | use Zef::Distribution::Local; 18 | use Zef::Service::FileReporter; 19 | 20 | my $reporter = Zef::Service::FileReporter.new; 21 | 22 | # Add logging if we want to see output 23 | my $stdout = Supplier.new; 24 | my $stderr = Supplier.new; 25 | $stdout.Supply.tap: { say $_ }; 26 | $stderr.Supply.tap: { note $_ }; 27 | 28 | # Assuming our current directory is a raku distribution 29 | my $dist = Zef::Distribution::Local.new($*CWD); 30 | my $candidate = Candidate.new(:$dist); 31 | my $reported = so $reporter.report($candidate, :$stdout, :$stderr); 32 | say $reported ?? "Report Success" !! "Report Failure"; 33 | 34 | =end code 35 | 36 | =head1 Description 37 | 38 | C class that serves as an example of a reporter. 39 | 40 | Note this doesn't yet save e.g. test output in a way that can be recorded, such as attaching it to 41 | C or to a temp file linked to that C. 42 | 43 | =head1 Methods 44 | 45 | =head2 method probe 46 | 47 | method probe(--> Bool:D) 48 | 49 | Always returns C since this is backed by C. 50 | 51 | =head2 method report 52 | 53 | method report(Candidate $candi, Supplier $stdout, Supplier $stderr --> Bool:D) 54 | 55 | Given C<$candi> it will save various information including the distribution meta data, system information, 56 | if the tests passed, and (in the future, so nyi) test output. A C can be supplied as C<:$stdout> 57 | and C<:$stderr> to receive any output. 58 | 59 | Returns C if the report data was saved successfully. 60 | 61 | =end pod 62 | 63 | 64 | method probe(--> Bool:D) { return True } 65 | 66 | method report(Candidate $candi, Supplier :$stdout, Supplier :$stderr) { 67 | my $report-json = Zef::to-json(:pretty, { 68 | :name($candi.dist.name), 69 | :version(first *.defined, $candi.dist.meta), 70 | :dependencies($candi.dist.meta), 71 | :metainfo($candi.dist.meta.hash), 72 | :build-passed($candi.build-results.map(*.not).none.so), 73 | :test-passed($candi.test-results.map(*.not).none.so), 74 | :distro({ 75 | :name($*DISTRO.name), 76 | :version($*DISTRO.version.Str), 77 | :auth($*DISTRO.auth), 78 | :release($*DISTRO.release), 79 | }), 80 | :kernel({ 81 | :name($*KERNEL.name), 82 | :version($*KERNEL.version.Str), 83 | :auth($*KERNEL.auth), 84 | :release($*KERNEL.release), 85 | :hardware($*KERNEL.hardware), 86 | :arch($*KERNEL.arch), 87 | :bits($*KERNEL.bits), 88 | }), 89 | :perl({ 90 | :name($*RAKU.name), 91 | :version($*RAKU.version.Str), 92 | :auth($*RAKU.auth), 93 | :compiler({ 94 | :name($*RAKU.compiler.name), 95 | :version($*RAKU.compiler.version.Str), 96 | :auth($*RAKU.compiler.auth), 97 | :release($*RAKU.compiler.release), 98 | :codename($*RAKU.compiler.codename), 99 | }), 100 | }), 101 | :vm({ 102 | :name($*VM.name), 103 | :version($*VM.version.Str), 104 | :auth($*VM.auth), 105 | :config($*VM.config), 106 | :properties($*VM.?properties), 107 | :precomp-ext($*VM.precomp-ext), 108 | :precomp-target($*VM.precomp-target), 109 | :prefix($*VM.prefix.Str), 110 | }), 111 | }); 112 | 113 | my $out-file = $*TMPDIR.add("zef-report_{rand}"); 114 | 115 | try { 116 | CATCH { 117 | default { 118 | $stderr.emit("Encountered problems sending test report for {$candi.dist.identity}"); 119 | return False; 120 | } 121 | } 122 | 123 | $out-file.spurt: $report-json; 124 | 125 | $stdout.emit("Report for {$candi.dist.identity} will be available at {$out-file.absolute}"); 126 | } 127 | 128 | return $out-file.e; 129 | } 130 | } 131 | 132 | -------------------------------------------------------------------------------- /lib/Zef/Build.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Distribution:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | class Zef::Build does Builder does Pluggable { 6 | 7 | =begin pod 8 | 9 | =title class Zef::Build 10 | 11 | =subtitle A configurable implementation of the Builder interface 12 | 13 | =head1 Synopsis 14 | 15 | =begin code :lang 16 | 17 | use Zef; 18 | use Zef::Build; 19 | use Zef::Distribution::Local; 20 | 21 | # Setup with a single builder backend 22 | my $builder = Zef::Build.new( 23 | backends => [ 24 | { module => "Zef::Service::Shell::LegacyBuild" }, 25 | ], 26 | ); 27 | 28 | # Assuming our current directory is a raku distribution with a Build.rakumod file... 29 | my $dist-to-build = Zef::Distribution::Local.new($*CWD); 30 | my $candidate = Candidate.new(dist => $dist-to-build); 31 | my $logger = Supplier.new andthen *.Supply.tap: -> $m { say $m. } 32 | 33 | my $build-ok = so all $builder.build($candidate, :$logger); 34 | say $build-ok ?? "Build OK" !! "Something went wrong..."; 35 | 36 | =end code 37 | 38 | =head1 Description 39 | 40 | A C that uses 1 or more other C instances as backends. It abstracts the logic 41 | to do 'build this distribution with the first backend that supports the given distribution'. 42 | 43 | =head1 Methods 44 | 45 | =head2 method build-matcher 46 | 47 | method build-matcher(Zef::Distribution $dist --> Bool:D) 48 | 49 | Returns C if any of the probeable C know how to build C<$dist>. 50 | 51 | =head2 method build 52 | 53 | method build(Candidate $candi, Str :@includes, Supplier :$logger, Int :$timeout, :$meta --> Array[Bool]) 54 | 55 | Builds the distribution for C<$candi>. For more info see C and C 56 | since the build step process is coupled tightly to the backend used. 57 | 58 | An optional C<:$logger> can be supplied to receive events about what is occuring. 59 | 60 | An optional C<:$timeout> can be passed to denote the number of seconds after which we'll assume failure. 61 | 62 | Returns an C with some number of C (which depends on the backend used). If there are no C items 63 | in the returned C then we assume success. 64 | 65 | =end pod 66 | 67 | 68 | submethod TWEAK(|) { 69 | @ = self.plugins; # preload plugins 70 | } 71 | 72 | #| Returns true if any of the backends 'build-matcher' understand the given uri/path 73 | method build-matcher(Zef::Distribution $dist --> Bool:D) { return so self!build-matcher($dist) } 74 | 75 | #| Returns the backends that understand the given uri based on their build-matcher result 76 | method !build-matcher(Zef::Distribution $dist --> Array[Builder]) { 77 | my @matching-backends = self.plugins.grep(*.build-matcher($dist)); 78 | 79 | my Builder @results = @matching-backends; 80 | return @results; 81 | } 82 | 83 | #| Build the given path using any provided @includes 84 | #| Will return results from the first Builder backend that supports the given $candi.dist (distribution) 85 | method build(Candidate $candi, Str :@includes, Supplier :$logger, Int :$timeout --> Array[Bool]) { 86 | my $dist := $candi.dist; 87 | die "Can't build non-existent path: {$dist.path}" unless $dist.path.IO.e; 88 | 89 | my $builder = self!build-matcher($dist).first(*.so); 90 | die "No building backend available" unless ?$builder; 91 | 92 | my $stdout = Supplier.new; 93 | my $stderr = Supplier.new; 94 | 95 | if ?$logger { 96 | $logger.emit({ level => DEBUG, stage => BUILD, phase => START, candi => $candi, message => "Building with plugin: {$builder.^name}" }); 97 | $stdout.Supply.grep(*.defined).act: -> $out { $logger.emit({ level => VERBOSE, stage => BUILD, phase => LIVE, candi => $candi, message => $out }) } 98 | $stderr.Supply.grep(*.defined).act: -> $err { $logger.emit({ level => ERROR, stage => BUILD, phase => LIVE, candi => $candi, message => $err }) } 99 | } 100 | 101 | my $todo = start { try $builder.build($dist, :@includes, :$stdout, :$stderr) }; 102 | my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new); 103 | await Promise.anyof: $todo, $time-up; 104 | $logger.emit({ level => DEBUG, stage => BUILD, phase => LIVE, candi => $candi, message => "Building {$dist.path} timed out" }) 105 | if ?$logger && $time-up.so && $todo.not; 106 | 107 | $stdout.done(); 108 | $stderr.done(); 109 | 110 | my Bool @results = $todo.so ?? $todo.result !! False; 111 | return @results; 112 | } 113 | } 114 | -------------------------------------------------------------------------------- /lib/Zef/Install.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Distribution:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | class Zef::Install does Installer does Pluggable { 6 | 7 | =begin pod 8 | 9 | =title class Zef::Install 10 | 11 | =subtitle A configurable implementation of the Installer interface 12 | 13 | =head1 Synopsis 14 | 15 | =begin code :lang 16 | 17 | use Zef; 18 | use Zef::Install; 19 | use Zef::Distribution::Local; 20 | 21 | # Setup with a single installer backend 22 | my $installer = Zef::Install.new( 23 | backends => [ 24 | { module => "Zef::Service::InstallRakuDistribution" }, 25 | ], 26 | ); 27 | 28 | # Assuming our current directory is a raku distribution... 29 | my $dist-to-install = Zef::Distribution::Local.new($*CWD); 30 | my $candidate = Candidate.new(dist => $dist-to-install); 31 | my $install-to-repo = CompUnit::RepositoryRegistry.repository-for-name("site"); 32 | 33 | # ...install the distribution using the first available backend 34 | my $installed = so $installer.install($candidate, :cur($install-to-repo)); 35 | say $installed ?? 'Install OK' !! 'Something went wrong...'; 36 | 37 | =end code 38 | 39 | =head1 Description 40 | 41 | An C class that uses 1 or more other C instances as backends. It abstracts the logic 42 | to do 'install this distribution with the first backend that supports the given distribution'. 43 | 44 | =head1 Methods 45 | 46 | =head2 method install-matcher 47 | 48 | method install-matcher(Zef::Distribution $dist --> Bool:D) 49 | 50 | Returns C if any of the probeable C know how to install C<$dist>. 51 | 52 | =head2 method install 53 | 54 | method install(Candidate $candi, CompUnit::Repository :$cur!, Bool :$force, Bool :$precompile, Supplier :$logger, Int :$timeout --> Bool:D) 55 | 56 | Installs the distribution C<$candi.dist> to C<$cur> (see synopsis). Set C<$force> to C to allow installing a distribution 57 | that is already installed. If C<$precompile> is C then it will not precompile during installation. 58 | 59 | An optional C<:$logger> can be supplied to receive events about what is occurring. 60 | 61 | An optional C<:$timeout> can be passed to denote the number of seconds after which we'll assume failure. 62 | 63 | Returns C if the installation succeeded. 64 | 65 | Note In the future this might have backends allowing installation of e.g. Python modules for things using C. 66 | 67 | =end pod 68 | 69 | 70 | submethod TWEAK(|) { 71 | @ = self.plugins; # preload plugins 72 | } 73 | 74 | #| Returns true if any of the backends 'build-matcher' understand the given uri/path 75 | method install-matcher(Zef::Distribution $dist --> Bool:D) { return so self!install-matcher($dist) } 76 | 77 | #| Returns the backends that understand the given uri based on their build-matcher result 78 | method !install-matcher(Zef::Distribution $dist --> Array[Installer]) { 79 | my @matching-backends = self.plugins.grep(*.install-matcher($dist)); 80 | 81 | my Installer @results = @matching-backends; 82 | return @results; 83 | } 84 | 85 | #| Install the distribution in $candi.dist to the $cur CompUnit::Repository. 86 | #| Use :force to install over an existing distribution using the same name/auth/ver/api 87 | method install(Candidate $candi, CompUnit::Repository :$cur!, Bool :$force, Bool :$precompile, Supplier :$logger, Int :$timeout --> Bool:D) { 88 | my $dist = $candi.dist; 89 | my $installer = self!install-matcher($dist).first(*.so); 90 | die "No installing backend available" unless ?$installer; 91 | 92 | my $stdout = Supplier.new; 93 | my $stderr = Supplier.new; 94 | if ?$logger { 95 | $logger.emit({ level => DEBUG, stage => INSTALL, phase => START, candi => $candi, message => "Installing with plugin: {$installer.^name}" }); 96 | $stdout.Supply.grep(*.defined).act: -> $out { $logger.emit({ level => VERBOSE, stage => INSTALL, phase => LIVE, candi => $candi, message => $out }) } 97 | $stderr.Supply.grep(*.defined).act: -> $err { $logger.emit({ level => ERROR, stage => INSTALL, phase => LIVE, candi => $candi, message => $err }) } 98 | } 99 | 100 | my $todo = start { $installer.install($dist, :$cur, :$force, :$stdout, :$stderr) }; 101 | my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new); 102 | await Promise.anyof: $todo, $time-up; 103 | $logger.emit({ level => DEBUG, stage => INSTALL, phase => LIVE, candi => $candi, message => "Installing {$dist.path} timed out" }) 104 | if ?$logger && $time-up.so && $todo.not; 105 | 106 | my $got = $todo.so ?? $todo.result !! False; 107 | 108 | $stdout.done(); 109 | $stderr.done(); 110 | 111 | return $got; 112 | } 113 | } 114 | -------------------------------------------------------------------------------- /resources/config.json: -------------------------------------------------------------------------------- 1 | { 2 | "ConfigVersion" : "1", 3 | "StoreDir" : "$*HOME/.zef/store", 4 | "TempDir" : "$*TMPDIR/.zef.{time}.{$*PID}", 5 | "DefaultCUR" : ["auto"], 6 | "License" : { 7 | "whitelist" : "*", 8 | "blacklist" : [] 9 | }, 10 | "Install" : [ 11 | { 12 | "short-name" : "install-raku-dist", 13 | "enabled" : 1, 14 | "module" : "Zef::Service::InstallRakuDistribution" 15 | } 16 | ], 17 | "Report" : [ 18 | { 19 | "short-name" : "file-reporter", 20 | "enabled" : 0, 21 | "module" : "Zef::Service::FileReporter" 22 | } 23 | ], 24 | "Repository" : [ 25 | [ 26 | { 27 | "short-name": "fez", 28 | "enabled": 1, 29 | "module": "Zef::Repository::Ecosystems", 30 | "options": { 31 | "name": "fez", 32 | "auto-update": 1, 33 | "uses-path": true, 34 | "mirrors": [ 35 | "https://360.zef.pm/" 36 | ] 37 | } 38 | } 39 | ], 40 | [ 41 | { 42 | "short-name" : "cpan", 43 | "enabled" : 0, 44 | "module" : "Zef::Repository::Ecosystems", 45 | "options" : { 46 | "name" : "cpan", 47 | "auto-update" : 1, 48 | "mirrors" : [ 49 | "https://raw.githubusercontent.com/ugexe/Perl6-ecosystems/master/cpan1.json", 50 | "https://raw.githubusercontent.com/ugexe/Perl6-ecosystems/master/cpan.json", 51 | "https://github.com/ugexe/Perl6-ecosystems.git" 52 | ] 53 | } 54 | }, 55 | { 56 | "short-name" : "p6c", 57 | "enabled" : 0, 58 | "module" : "Zef::Repository::Ecosystems", 59 | "options" : { 60 | "name" : "p6c", 61 | "auto-update" : 1, 62 | "mirrors" : [ 63 | "https://raw.githubusercontent.com/ugexe/Perl6-ecosystems/master/p6c1.json", 64 | "https://github.com/ugexe/Perl6-ecosystems.git", 65 | "https://ecosystem-api.p6c.org/projects1.json" 66 | ] 67 | } 68 | } 69 | ], 70 | [ 71 | { 72 | "short-name": "rea", 73 | "enabled": 1, 74 | "module": "Zef::Repository::Ecosystems", 75 | "options": { 76 | "name": "rea", 77 | "auto-update": 1, 78 | "mirrors": [ 79 | "https://raw.githubusercontent.com/Raku/REA/main/META.json" 80 | ] 81 | } 82 | } 83 | ], 84 | [ 85 | { 86 | "short-name" : "cached", 87 | "enabled" : 1, 88 | "module" : "Zef::Repository::LocalCache", 89 | "options" : { } 90 | } 91 | ] 92 | ], 93 | "Fetch" : [ 94 | { 95 | "short-name" : "git", 96 | "module" : "Zef::Service::Shell::git", 97 | "options" : { 98 | "scheme" : "https" 99 | } 100 | }, 101 | { 102 | "short-name" : "path", 103 | "module" : "Zef::Service::FetchPath" 104 | }, 105 | { 106 | "short-name" : "curl", 107 | "module" : "Zef::Service::Shell::curl" 108 | }, 109 | { 110 | "short-name" : "wget", 111 | "module" : "Zef::Service::Shell::wget" 112 | } 113 | ], 114 | "Extract" : [ 115 | { 116 | "short-name" : "git", 117 | "module" : "Zef::Service::Shell::git", 118 | "comment" : "used to checkout (extract) specific tags/sha1/commit/branch from a git repo" 119 | }, 120 | { 121 | "short-name" : "tar", 122 | "module" : "Zef::Service::Shell::tar" 123 | }, 124 | { 125 | "short-name" : "unzip", 126 | "module" : "Zef::Service::Shell::unzip" 127 | }, 128 | { 129 | "short-name" : "path", 130 | "module" : "Zef::Service::FetchPath", 131 | "comment" : "if this goes before git then git wont be able to extract/checkout local paths because this reaches it first :(" 132 | } 133 | ], 134 | "Build" : [ 135 | { 136 | "short-name" : "default-builder", 137 | "module" : "Zef::Service::Shell::DistributionBuilder" 138 | }, 139 | { 140 | "short-name" : "legacy-builder", 141 | "module" : "Zef::Service::Shell::LegacyBuild" 142 | } 143 | ], 144 | "Test" : [ 145 | { 146 | "short-name" : "tap-harness", 147 | "module" : "Zef::Service::TAP", 148 | "comment" : "Raku TAP::Harness adapter" 149 | }, 150 | { 151 | "short-name" : "raku-test", 152 | "module" : "Zef::Service::Shell::Test" 153 | } 154 | ] 155 | } 156 | -------------------------------------------------------------------------------- /lib/Zef/Test.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | 4 | class Zef::Test does Tester does Pluggable { 5 | 6 | =begin pod 7 | 8 | =title class Zef::Test 9 | 10 | =subtitle A configurable implementation of the Tester interface 11 | 12 | =head1 Synopsis 13 | 14 | =begin code :lang 15 | 16 | use Zef; 17 | use Zef::Test; 18 | use Zef::Distribution::Local; 19 | 20 | # Setup with a single tester backend 21 | my $tester = Zef::Test.new( 22 | backends => [ 23 | { module => "Zef::Service::Shell::Test" }, 24 | ], 25 | ); 26 | 27 | # Assuming our current directory is a raku distribution... 28 | my $dist-to-test = Zef::Distribution::Local.new($*CWD); 29 | my $candidate = Candidate.new(dist => $dist-to-test); 30 | my $logger = Supplier.new andthen *.Supply.tap: -> $m { say $m. } 31 | 32 | # ...test the distribution using the first available backend 33 | my $passed = so all $tester.test($candidate, :$logger); 34 | say $passed ?? "PASS" !! "FAIL"; 35 | 36 | =end code 37 | 38 | =head1 Description 39 | 40 | A C class that uses 1 or more other C instances as backends. It abstracts the logic 41 | to do 'test this path with the first backend that supports the given path'. 42 | 43 | =head1 Methods 44 | 45 | =head2 method test-matcher 46 | 47 | method test-matcher($path --> Bool:D) 48 | 49 | Returns C if any of the probeable C know how to test C<$path>. 50 | 51 | =head2 method test 52 | 53 | method test(Candidate $candi, Str :@includes, Supplier :$logger, Int :$timeout --> Array[Bool]) 54 | 55 | Tests the files for C<$candi> (usually locally extracted files from C<$candi.dist> in the C directory with an extension 56 | of C<.rakutest> C<.t6> or C<.t>) using the provided C<@includes> (e.g. C or C. It will use 57 | the first matching backend, and will not attempt to use a different backend on failure (like e.g. C) since 58 | failing test are not unexpected. 59 | 60 | An optional C<:$logger> can be supplied to receive events about what is occurring. 61 | 62 | An optional C<:$timeout> can be passed to denote the number of seconds after which we'll assume failure. 63 | 64 | Returns an C with some number of C (which depends on the backend used). If there are no C items 65 | in the returned C then we assume success. 66 | 67 | =end pod 68 | 69 | 70 | submethod TWEAK(|) { 71 | @ = self.plugins; # preload plugins 72 | } 73 | 74 | #| Returns true if any of the backends 'test-matcher' understand the given uri/path 75 | method test-matcher($path --> Bool:D) { return so self!test-matcher($path) } 76 | 77 | #| Returns the backends that understand the given uri based on their test-matcher result 78 | method !test-matcher($path --> Array[Tester]) { 79 | my @matching-backends = self.plugins.grep(*.test-matcher($path)); 80 | 81 | my Tester @results = @matching-backends; 82 | return @results; 83 | } 84 | 85 | #| Test the given path using any provided @includes, 86 | #| Will return results from the first Tester backend that supports the given path (via $candi.dist.path) 87 | method test(Candidate $candi, Str :@includes, Supplier :$logger, Int :$timeout --> Array[Bool]) { 88 | my $path := $candi.dist.path; 89 | die "Can't test non-existent path: {$path}" unless $path.IO.e; 90 | 91 | my $testers := self!test-matcher($path).cache; 92 | 93 | unless +$testers { 94 | my @report_enabled = self.plugins.map(*.short-name); 95 | my @report_disabled = self.backends.map(*.).grep({ $_ ~~ none(@report_enabled) }); 96 | 97 | die "Enabled testing backends [{@report_enabled}] don't understand $path\n" 98 | ~ "You may need to configure one of the following backends, or install its underlying software - [{@report_disabled}]"; 99 | } 100 | 101 | my $tester = $testers.head; 102 | 103 | my $stdout = Supplier.new; 104 | my $stderr = Supplier.new; 105 | if ?$logger { 106 | $logger.emit({ level => DEBUG, stage => TEST, phase => START, candi => $candi, message => "Testing with plugin: {$tester.^name}" }); 107 | $stdout.Supply.grep(*.defined).act: -> $out is copy { $logger.emit({ level => VERBOSE, stage => TEST, phase => LIVE, candi => $candi, message => $out }) } 108 | $stderr.Supply.grep(*.defined).act: -> $err is copy { $logger.emit({ level => ERROR, stage => TEST, phase => LIVE, candi => $candi, message => $err }) } 109 | } 110 | 111 | my $todo = start { try $tester.test($path, :@includes, :$stdout, :$stderr) }; 112 | my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new); 113 | await Promise.anyof: $todo, $time-up; 114 | $logger.emit({ level => DEBUG, stage => TEST, phase => LIVE, message => "Testing $path timed out" }) 115 | if ?$logger && $time-up.so && $todo.not; 116 | 117 | my Bool @results = $todo.so ?? $todo.result !! False; 118 | 119 | $stdout.done(); 120 | $stderr.done(); 121 | 122 | return @results; 123 | } 124 | } 125 | -------------------------------------------------------------------------------- /lib/Zef/Fetch.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Utils::FileSystem:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | class Zef::Fetch does Fetcher does Pluggable { 6 | 7 | =begin pod 8 | 9 | =title class Zef::Fetch 10 | 11 | =subtitle A configurable implementation of the Fetcher interface 12 | 13 | =head1 Synopsis 14 | 15 | =begin code :lang 16 | 17 | use Zef; 18 | use Zef::Fetch; 19 | 20 | # Setup with a single fetcher backend 21 | my $fetcher = Zef::Fetch.new( 22 | backends => [ 23 | { module => "Zef::Service::Shell::curl" }, 24 | { module => "Zef::Service::Shell::wget" }, 25 | ], 26 | ); 27 | 28 | # Save the content of $uri to $save-to 29 | my $uri = "https://httpbin.org/ip"; 30 | my $save-to = $*CWD.child("output.txt"); 31 | my $saved-to = $fetcher.fetch(Candidate.new(:$uri), $save-to); 32 | 33 | say $saved-to ?? $saved-to.slurp !! "Failed to download and save"; 34 | 35 | =end code 36 | 37 | =head1 Description 38 | 39 | A C class that uses 1 or more other C instances as backends. It abstracts the logic 40 | to do 'grab this uri with the first backend that supports the given uri'. 41 | 42 | =head1 Methods 43 | 44 | =head2 method fetch-matcher 45 | 46 | method fetch-matcher($path --> Bool:D) 47 | 48 | Returns C if any of the probeable C know how to fetch C<$path>. 49 | 50 | =head2 method fetch 51 | 52 | method fetch(Candidate $candi, IO() $save-to, Supplier :$logger, Int :$timeout --> IO::Path) 53 | 54 | Fetches the files for C<$candi> (usually as C<$candi.uri>) to C<$save-to>. If a backend fails to fetch 55 | for some reason (such as going over its C<:$timeout>) the next matching backend will be used. Failure occurs 56 | when no backend was able to fetch the C<$candi>. 57 | 58 | An optional C<:$logger> can be supplied to receive events about what is occurring. 59 | 60 | An optional C<:$timeout> can be passed to denote the number of seconds after which we'll assume failure. 61 | 62 | On success it returns the C where the data was actually fetched to. On failure it returns C. 63 | 64 | Note this differs from other 'Fetcher' adapters C (i.e. the fetchers this uses as backends) which 65 | take a C as the first parameter, not a C. 66 | 67 | =end pod 68 | 69 | 70 | submethod TWEAK(|) { 71 | @ = self.plugins; # preload plugins 72 | } 73 | 74 | #| Returns true if any of the backends 'fetch-matcher' understand the given uri/path 75 | method fetch-matcher($uri --> Bool:D) { return so self!fetch-matcher($uri) } 76 | 77 | #| Returns the backends that understand the given uri based on their fetch-matcher result 78 | method !fetch-matcher($uri --> Array[Fetcher]) { 79 | my @matching-backends = self.plugins.grep(*.fetch-matcher($uri)); 80 | 81 | my Fetcher @results = @matching-backends; 82 | return @results; 83 | } 84 | 85 | #| Fetch the given url. 86 | #| Will return the first successful result while attempting to fetch the given $candi. 87 | method fetch(Candidate $candi, IO() $save-to, Supplier :$logger, Int :$timeout --> IO::Path) { 88 | my $uri = $candi.uri; 89 | my @fetchers = self!fetch-matcher($uri).cache; 90 | 91 | unless +@fetchers { 92 | my @report_enabled = self.plugins.map(*.short-name); 93 | my @report_disabled = self.backends.map(*.).grep({ $_ ~~ none(@report_enabled) }); 94 | 95 | die "Enabled fetching backends [{@report_enabled}] don't understand $uri\n" 96 | ~ "You may need to configure one of the following backends, or install its underlying software - [{@report_disabled}]"; 97 | } 98 | 99 | my $stdout = Supplier.new; 100 | my $stderr = Supplier.new; 101 | if ?$logger { 102 | $stdout.Supply.act: -> $out { $logger.emit({ level => VERBOSE, stage => FETCH, phase => LIVE, candi => $candi, message => $out }) } 103 | $stderr.Supply.act: -> $err { $logger.emit({ level => ERROR, stage => FETCH, phase => LIVE, candi => $candi, message => $err }) } 104 | } 105 | 106 | my $got := @fetchers.map: -> $fetcher { 107 | if ?$logger { 108 | $logger.emit({ level => DEBUG, stage => FETCH, phase => START, candi => $candi, message => "Fetching $uri with plugin: {$fetcher.^name}" }); 109 | } 110 | 111 | my $ret = lock-file-protect("{$save-to}.lock", -> { 112 | my $todo = start { try $fetcher.fetch($uri, $save-to, :$stdout, :$stderr) }; 113 | my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new); 114 | await Promise.anyof: $todo, $time-up; 115 | $logger.emit({ level => DEBUG, stage => FETCH, phase => LIVE, candi => $candi, message => "Fetching $uri timed out" }) 116 | if ?$logger && $time-up.so && $todo.not; 117 | $todo.so ?? $todo.result !! Nil; 118 | }); 119 | 120 | $ret; 121 | } 122 | 123 | my IO::Path $result = $got.grep(*.so).map(*.IO).head; 124 | 125 | $stdout.done(); 126 | $stderr.done(); 127 | 128 | return $result; 129 | } 130 | } 131 | 132 | -------------------------------------------------------------------------------- /lib/Zef/Service/Shell/unzip.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | 4 | class Zef::Service::Shell::unzip does Extractor { 5 | 6 | =begin pod 7 | 8 | =title class Zef::Service::Shell::unzip 9 | 10 | =subtitle An unzip based implementation of the Extractor interface 11 | 12 | =head1 Synopsis 13 | 14 | =begin code :lang 15 | 16 | use Zef; 17 | use Zef::Service::Shell::unzip; 18 | 19 | my $unzip = Zef::Service::Shell::unzip.new; 20 | 21 | # Assuming a zef-main.zip file is in the cwd... 22 | my $source = $*HOME.child("zef-main.zip"); 23 | my $extract-to = $*TMPDIR.child(time); 24 | my $extracted-to = $unzip.extract($source, $extract-to); 25 | 26 | die "Something went wrong" unless $extracted-to; 27 | say "Zef META6 from HEAD: "; 28 | say $extracted-to.child("zef-main/META6.json").slurp; 29 | 30 | =end code 31 | 32 | =head1 Description 33 | 34 | C class for handling file based URIs ending in .zip using the C command. 35 | 36 | You probably never want to use this unless its indirectly through C; 37 | handling files and spawning processes will generally be easier using core language functionality. This 38 | class exists to provide the means for fetching a file using the C interfaces that the e.g. git/tar 39 | adapters use. 40 | 41 | =head1 Methods 42 | 43 | =head2 method probe 44 | 45 | method probe(--> Bool:D) 46 | 47 | Returns C if this module can successfully launch the C command. 48 | 49 | =head2 method extract-matcher 50 | 51 | method extract-matcher(Str() $uri --> Bool:D) 52 | 53 | Returns C if this module knows how to extract C<$uri>, which it decides based on if C<$uri> is 54 | an existing local file and ends with C<.zip>. 55 | 56 | =head2 method extract 57 | 58 | method extract(IO() $archive-file, IO() $extract-to, Supplier :$stdout, Supplier :$stderr --> IO::Path) 59 | 60 | Extracts the files in C<$archive-file> to C<$save-to> via the C command. A C can be supplied 61 | as C<:$stdout> and C<:$stderr> to receive any output. 62 | 63 | On success it returns the C where the data was actually extracted to. On failure it returns C. 64 | 65 | =head2 method ls-files 66 | 67 | method ls-files(IO() $archive-file, Supplier :$stdout, Supplier :$stderr --> Array[Str]) 68 | 69 | On success it returns an C of relative paths that are available to be extracted from C<$archive-file>. 70 | A C can be supplied as C<:$stdout> and C<:$stderr> to receive any output. 71 | 72 | =end pod 73 | 74 | my Lock $probe-lock = Lock.new; 75 | my Bool $probe-cache; 76 | 77 | #| Return true if the `unzip` command is available to use 78 | method probe(--> Bool:D) { 79 | $probe-lock.protect: { 80 | return $probe-cache if $probe-cache.defined; 81 | my $probe is default(False) = try so Zef::zrun('unzip', '--help', :!out, :!err); 82 | return $probe-cache = $probe; 83 | } 84 | } 85 | 86 | #| Return true if this Fetcher understands the given uri/path 87 | method extract-matcher(Str() $uri --> Bool:D) { 88 | return so $uri.IO.extension.lc eq 'zip'; 89 | } 90 | 91 | #| Extract the given $archive-file 92 | method extract(IO() $archive-file, IO() $extract-to, Supplier :$stdout, Supplier :$stderr --> IO::Path) { 93 | die "archive file does not exist: {$archive-file.absolute}" 94 | unless $archive-file.e && $archive-file.f; 95 | die "target extraction directory {$extract-to.absolute} does not exist and could not be created" 96 | unless ($extract-to.e && $extract-to.d) || mkdir($extract-to); 97 | 98 | my $passed; 99 | react { 100 | my $cwd := $archive-file.parent; 101 | my $ENV := %*ENV; 102 | my $proc = Zef::zrun-async('unzip', '-o', '-qq', $archive-file.basename, '-d', $extract-to.absolute); 103 | $stdout.emit("Command: {$proc.command}"); 104 | whenever $proc.stdout(:bin) { } 105 | whenever $proc.stderr(:bin) { } 106 | whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } 107 | } 108 | 109 | return $passed ?? $extract-to !! Nil; 110 | } 111 | 112 | #| Returns an array of strings, where each string is a relative path representing a file that can be extracted from the given $archive-file 113 | method ls-files(IO() $archive-file, Supplier :$stdout, Supplier :$stderr) { 114 | die "archive file does not exist: {$archive-file.absolute}" 115 | unless $archive-file.e && $archive-file.f; 116 | 117 | my $passed; 118 | my $output = Buf.new; 119 | react { 120 | my $cwd := $archive-file.parent; 121 | my $ENV := %*ENV; 122 | my $proc = Zef::zrun-async('unzip', '-Z', '-1', $archive-file.basename); 123 | $stdout.emit("Command: {$proc.command}"); 124 | whenever $proc.stdout(:bin) { $output.append($_) } 125 | whenever $proc.stderr(:bin) { } 126 | whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } 127 | } 128 | 129 | my @extracted-paths = $output.decode.lines; 130 | 131 | my Str @results = $passed ?? @extracted-paths.grep(*.defined) !! (); 132 | return @results; 133 | } 134 | } 135 | -------------------------------------------------------------------------------- /lib/Zef/Service/Shell/DistributionBuilder.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Distribution::Local:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | class Zef::Service::Shell::DistributionBuilder does Builder { 6 | 7 | =begin pod 8 | 9 | =title class Zef::Service::Shell::DistributionBuilder 10 | 11 | =subtitle A META6-supplied raku module based implementation of the Builder interface 12 | 13 | =head1 Synopsis 14 | 15 | =begin code :lang 16 | 17 | use Zef; 18 | use Zef::Service::Shell::DistributionBuilder; 19 | 20 | my $builder = Zef::Service::Shell::DistributionBuilder.new; 21 | 22 | # Add logging if we want to see output 23 | my $stdout = Supplier.new; 24 | my $stderr = Supplier.new; 25 | $stdout.Supply.tap: { say $_ }; 26 | $stderr.Supply.tap: { note $_ }; 27 | 28 | # Assuming our current directory is a raku distribution with something like 29 | # `"builder" : "Distribution::Builder::MakeFromJSON"` in its META6.json 30 | # and has no dependencies (or all dependencies already installed)... 31 | my $dist-to-build = Zef::Distribution::Local.new($*CWD); 32 | my Str @includes = $*CWD.absolute; 33 | my $built-ok = so $builder.build($dist-to-build, :@includes, :$stdout, :$stderr); 34 | say $built-ok ?? "OK" !! "Something went wrong"; 35 | 36 | =end code 37 | 38 | =head1 Description 39 | 40 | C class for handling local distributions that include a C<"builder" : "..."> in their C. 41 | For example C<"builder" : "Distribution::Builder::MakeFromJSON"> will spawn a process where it passes the 42 | module C the path of the distribution and the parsed meta data (from which 43 | it may use other instructions from non-standard fields in the C). 44 | 45 | =head1 Methods 46 | 47 | =head2 method probe 48 | 49 | method probe(--> Bool:D) 50 | 51 | Returns C if this module can successfully launch the C command (i.e. always returns C). 52 | 53 | =head2 method build-matcher 54 | 55 | method build-matcher(Zef::Distribution::Local $dist --> Bool:D) 56 | 57 | Returns C if this module knows how to test C<$uri>. This module always returns C right now since 58 | it just uses the C command. 59 | 60 | =head2 method build 61 | 62 | method build(Zef::Distribution::Local $dist, Str :@includes, Supplier :$stdout, Supplier :$stderr --> Bool:D) 63 | 64 | Launches a process to invoke whatever module is in the C field of the C<$dist> META6.json while passing 65 | that module the meta data of C<$dist> it is to build (allowing non-spec keys to be used by such modules to allow 66 | consumers/authors to supply additional data). A C can be supplied as C<:$stdout> and C<:$stderr> to receive 67 | any output. 68 | 69 | See C in the ecosystem for an example of such a C, and see C 70 | for an example of a distribution built using such a C. 71 | 72 | Returns C if the C process spawned to run the build module exits 0. 73 | 74 | =end pod 75 | 76 | 77 | #| Return true always since it just requires launching another raku process 78 | method probe { True } 79 | 80 | #| Return true if this Builder understands the given meta data (has a 'builder' key) of the provided distribution 81 | method build-matcher(Zef::Distribution::Local $dist) { so $dist.builder } 82 | 83 | #| Run the build step of this distribution. 84 | method build(Zef::Distribution::Local $dist, Str :@includes, Supplier :$stdout, Supplier :$stderr --> Bool:D) { 85 | die "path does not exist: {$dist.path}" unless $dist.path.IO.e; 86 | 87 | # todo: remove this ( and corresponding code in Zef::Distribution.build-depends-specs ) in the near future 88 | # Always use the full name 'Distribution::Builder::MakeFromJSON', not 'MakeFromJSON' 89 | my $dist-builder-compat = "$dist.builder()" eq 'MakeFromJSON' 90 | ?? "Distribution::Builder::MakeFromJSON" 91 | !! "$dist.builder()"; 92 | 93 | my $tmp-meta-file = do given $*TMPDIR.child("zef-distribution-builder/") { 94 | my $dir = $_.child(Date.today); 95 | mkdir $dir; 96 | $dir = $dir.child("{time}-{$*PID}-{$*THREAD.id}"); 97 | mkdir $dir; 98 | $dir.child('META6.json').absolute; 99 | } 100 | 101 | $tmp-meta-file.IO.spurt(Zef::to-json($dist.meta.hash), :close); 102 | 103 | my $cmd = "exit((require ::(q|$dist-builder-compat|)).new(" 104 | ~ ":meta(Distribution::Path.new({$tmp-meta-file.IO.parent.absolute.raku}\.IO).meta.hash)" 105 | ~ ").build(q|$dist.path()|)" 106 | ~ '??0!!1)'; 107 | 108 | my @exec = |($*EXECUTABLE.absolute, |@includes.grep(*.defined).map({ "-I{$_}" }), '-e', "$cmd"); 109 | 110 | my $ENV := %*ENV; 111 | my $passed; 112 | react { 113 | my $proc = Zef::zrun-async(@exec, :w); 114 | $stdout.emit("Command: {$proc.command}"); 115 | whenever $proc.stdout.lines { $stdout.emit($_) } 116 | whenever $proc.stderr.lines { $stderr.emit($_) } 117 | whenever $proc.start(:$ENV, :cwd($dist.path)) { $passed = $_.so } 118 | } 119 | return $passed; 120 | } 121 | } 122 | -------------------------------------------------------------------------------- /lib/Zef/Utils/SystemQuery.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | module Zef::Utils::SystemQuery { 4 | 5 | =begin pod 6 | 7 | =title module Zef::Utils::SystemQuery 8 | 9 | =subtitle Utility subroutines for resolving declarative logic based dependencies 10 | 11 | =head1 Synopsis 12 | 13 | =begin code :lang 14 | 15 | use Zef::Utils::SystemQuery; 16 | 17 | my @depends = ( 18 | { 19 | "name" => { 20 | "by-distro.name" => { 21 | "mswin32" => "Windows::Dependency", 22 | "" => "NonWindows::Dependency" 23 | }, 24 | }, 25 | }, 26 | ); 27 | 28 | my @resolved-depends := system-collapse(@depends); 29 | 30 | say @resolved-depends.raku; 31 | # [{:name("Windows::Dependency")},] # on windows systems 32 | # [{:name("NonWindows::Dependency")},] # on non-windows systems 33 | 34 | =end code 35 | 36 | =head1 Description 37 | 38 | Provides facilities for resolving dependencies that use declarative logic. 39 | 40 | =head1 Subroutines 41 | 42 | =head2 sub system-collapse 43 | 44 | our sub system-collapse($data) 45 | 46 | Traverses an C or C C<$data>, collapsing the blocks of declarative logic and returns the 47 | otherwise same data structure. 48 | 49 | Declarative logic current supports three main query forms: 50 | 51 | # by-env-exists.$FOO - selects "yes" key %*ENV{$FOO} exists, else the "no" key 52 | "by-env-exists.FOO" : { 53 | "yes" : "Env::Exists", 54 | "no" : "Env::DoesNotExists" 55 | } 56 | 57 | # by-env.$FOO - selects the value of %*ENV{$FOO} as the key, else the "" key if there is no matching key 58 | "by-env.FOO" : { 59 | "SomeValue" : "Env::FOO::SomeValue", 60 | "" : "Env::FOO::DefaultValue" 61 | } 62 | 63 | # by-[distro|kernel|raku|vm].$FOO - selects the value of e.g. $*DISTRO.name as the key, else the "" key if there is no matching key 64 | # where $FOO is e.g. $*DISTRO.^methods (or $*KERNEL.^methods, $*RAKU.^methods, $*VM.^methods) 65 | "by-distro.name" : { 66 | "macosx" : "OSX::Dependency", 67 | "" : "NonOSX::Dependency" 68 | } 69 | 70 | Note that e.g. C<$*DISTRO.name> (and thus the C form) depends on potentially C backend 71 | specific stuff -- for instance libuv based backends would have similar e.g. C<$*DISTRO> values, but on the JVM C<$*DISTRO.name> 72 | might return "linux" when MoarVM returns "debian". When using this query form you will want to test on multiple systems. 73 | 74 | =end pod 75 | 76 | 77 | our sub system-collapse($data) is export { 78 | return $data unless $data ~~ Hash|Array; 79 | 80 | my sub walk(@path, $idx, $query-source) { 81 | die "Attempting to find \$*{@path[0].uc}.{@path[1..*].join('.')}" 82 | if !$query-source.^can("{@path[$idx]}") && $idx < @path.elems; 83 | return $query-source."{@path[$idx]}"() 84 | if $idx+1 == @path.elems; 85 | return walk(@path, $idx+1, $query-source."{@path[$idx]}"()); 86 | } 87 | 88 | my $return = $data.WHAT.new; 89 | 90 | for $data.keys -> $idx { 91 | given $idx { 92 | when /^'by-env-exists'/ { 93 | my $key = $idx.split('.')[1]; 94 | my $value = %*ENV{$key}:exists ?? 'yes' !! 'no'; 95 | die "Unable to resolve path: {$idx} in \%*ENV\nhad: {$value}" 96 | unless $data{$idx}{$value}:exists; 97 | return system-collapse($data{$idx}{$value}); 98 | } 99 | when /^'by-env'/ { 100 | my $key = $idx.split('.')[1]; 101 | my $value = %*ENV{$key}; 102 | die "Unable to resolve path: {$idx} in \%*ENV\nhad: {$value // ''}" 103 | unless defined($value) && ($data{$idx}{$value}:exists); 104 | return system-collapse($data{$idx}{$value}); 105 | } 106 | when /^'by-' (distro|kernel|perl|raku|vm)/ { 107 | my $query-source = do given $/[0] { 108 | when 'distro' { $*DISTRO } 109 | when 'kernel' { $*KERNEL } 110 | when 'perl' { $*RAKU } 111 | when 'raku' { $*RAKU } 112 | when 'vm' { $*VM } 113 | } 114 | my $path = $idx.split('.'); 115 | my $value = walk($path, 1, $query-source).Str; # to stringify e.g. True 116 | my $fkey = ($data{$idx}{$value}:exists) 117 | ?? $value 118 | !! ($data{$idx}{''}:exists) 119 | ?? '' 120 | !! Any; 121 | 122 | die "Unable to resolve path: {$path.cache[*-1].join('.')} in \$*DISTRO\nhad: {$value} ~~ {$value.WHAT.^name}" 123 | if Any ~~ $fkey; 124 | return system-collapse($data{$idx}{$fkey}); 125 | } 126 | default { 127 | my $val = system-collapse($data ~~ Array ?? $data[$idx] !! $data{$idx}); 128 | $return{$idx} = $val 129 | if $return ~~ Hash; 130 | $return.push($val) 131 | if $return ~~ Array; 132 | 133 | } 134 | }; 135 | } 136 | 137 | return $return; 138 | } 139 | } 140 | -------------------------------------------------------------------------------- /t/repository.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 1; 4 | 5 | use Zef; 6 | use Zef::Distribution; 7 | use Zef::Repository; 8 | 9 | 10 | subtest 'Zef::Repository.candidates' => { 11 | my class Mock::Repository::One does PackageRepository { 12 | method fetch-matcher(|--> True ) { } 13 | 14 | method search(*@_) { 15 | return Empty unless @_.any ~~ 'Foo::Quick'; 16 | my Candidate @candidates = 17 | Candidate.new( 18 | dist => Zef::Distribution.new(:name('Foo::Quick'), :ver<0>, :api<1>,), 19 | as => 'Foo::Quick', 20 | ), 21 | Candidate.new( 22 | dist => Zef::Distribution.new(:name('Foo::Quick'), :ver<0.1>, :api<2>), 23 | as => 'Foo::Quick', 24 | ), 25 | Candidate.new( 26 | dist => Zef::Distribution.new(:name('Foo::Quick'), :ver<0.2>, :api<1>), 27 | as => 'Foo::Quick', 28 | ); 29 | return @candidates; 30 | } 31 | } 32 | 33 | my class Mock::Repository::Two does PackageRepository { 34 | method fetch-matcher(|--> True) { } 35 | 36 | method search(*@_) { 37 | return Empty unless @_.any ~~ 'Foo::Quick'; 38 | my Candidate @candidates = 39 | Candidate.new( 40 | dist => Zef::Distribution.new(:name('Foo::Quick'), :ver<0.3>,), 41 | as => 'Foo::Quick', 42 | ), 43 | Candidate.new( 44 | dist => Zef::Distribution.new(:name('Foo::Quick'), :ver<0>,), 45 | as => 'Foo::Quick', 46 | ), 47 | Candidate.new( 48 | dist => Zef::Distribution.new(:name('Foo::Quick'), :ver<0>, :auth), 49 | as => 'Foo::Quick', 50 | ); 51 | return @candidates; 52 | } 53 | } 54 | 55 | my class Mock::Repository::Three does PackageRepository { 56 | method fetch-matcher(|--> True) { } 57 | 58 | method search(*@_) { 59 | return Empty unless @_.any ~~ 'Bar'; 60 | my Candidate @candidates = 61 | Candidate.new( 62 | dist => Zef::Distribution.new(:name('Bar'), :ver<0.1>,), 63 | as => 'Bar', 64 | ); 65 | return @candidates; 66 | } 67 | } 68 | 69 | subtest 'api + version sorting' => { 70 | { 71 | my $zef-repository = Zef::Repository.new but role :: { method plugins(|--> List) { [[Mock::Repository::One.new, Mock::Repository::Two.new],] } }; 72 | my @candidates = $zef-repository.candidates('Foo::Quick'); 73 | is @candidates.elems, 1, 'Results are grouped by Candidate.as'; 74 | is @candidates.head.dist.ver, v0.1, 'Results return sorted from highest api/ver to lowest'; 75 | } 76 | 77 | # Like the previous test, but switching the order of the plugins 78 | { 79 | my $zef-repository = Zef::Repository.new but role :: { method plugins(|--> List) { [[Mock::Repository::Two.new, Mock::Repository::One.new],] } }; 80 | my @candidates = $zef-repository.candidates('Foo::Quick'); 81 | is @candidates.elems, 1, 'Results are grouped by Candidate.as'; 82 | is @candidates.head.dist.ver, v0.1, 'Results return sorted from highest api/ver to lowest'; 83 | } 84 | } 85 | 86 | subtest 'tiered ecosystems with api + version sorting' => { 87 | { 88 | my $zef-repository = Zef::Repository.new but role :: { 89 | method plugins(|--> List) { 90 | [ 91 | [Mock::Repository::One.new,], 92 | [Mock::Repository::Two.new, Mock::Repository::Three.new], 93 | ] 94 | } 95 | } 96 | my @candidates = $zef-repository.candidates('Foo::Quick','Bar'); 97 | is @candidates.elems, 2, 'Results are grouped by Candidate.as'; 98 | 99 | my $foo-dist = @candidates.first({ .dist.name eq 'Foo::Quick' }).dist; 100 | ok $foo-dist, 'Found correct dist'; 101 | is $foo-dist.ver, v0.1, 'Found correct dist'; 102 | 103 | my $bar-dist = @candidates.first({ .dist.name eq 'Bar' }).dist; 104 | ok $bar-dist, 'Results return sorted from highest api/ver to lowest from first tier with any matches'; 105 | is $bar-dist.ver, v0.1, 'Results return sorted from highest api/ver to lowest from first tier with any matches'; 106 | } 107 | 108 | # Like the previous test, but switching the order of the plugins 109 | { 110 | my $zef-repository = Zef::Repository.new but role :: { 111 | method plugins(|--> List) { 112 | [ 113 | [Mock::Repository::Two.new, Mock::Repository::Three.new], 114 | [Mock::Repository::One.new,], 115 | ] 116 | } 117 | }; 118 | my @candidates = $zef-repository.candidates('Foo::Quick','Bar'); 119 | is @candidates.elems, 2, 'Results are grouped by Candidate.as'; 120 | 121 | my $foo-dist = @candidates.first({ .dist.name eq 'Foo::Quick' }).dist; 122 | ok $foo-dist, 'Found correct dist'; 123 | is $foo-dist.ver, v0.3, 'Found correct dist'; 124 | 125 | my $bar-dist = @candidates.first({ .dist.name eq 'Bar' }).dist; 126 | ok $bar-dist, 'Results return sorted from highest api/ver to lowest from first tier with any matches'; 127 | is $bar-dist.ver, v0.1, 'Results return sorted from highest api/ver to lowest from first tier with any matches'; 128 | } 129 | } 130 | } 131 | 132 | 133 | done-testing; -------------------------------------------------------------------------------- /lib/Zef/Service/FetchPath.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Utils::FileSystem:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | class Zef::Service::FetchPath does Fetcher does Extractor { 6 | 7 | =begin pod 8 | 9 | =title class Zef::Service::FetchPath 10 | 11 | =subtitle A file system based implementation of the Fetcher and Extractor interfaces 12 | 13 | =head1 Synopsis 14 | 15 | =begin code :lang 16 | 17 | use Zef; 18 | use Zef::Service::FetchPath; 19 | 20 | my $fetch-path = Zef::Service::FetchPath.new; 21 | 22 | # Copy the content of the current directory to ./backup_dir/$random/* 23 | my $source = $*CWD; 24 | my $save-to = $*CWD.child("backup_dir"); 25 | my $saved-to = $fetch-path.fetch($source, $save-to); 26 | 27 | die "Failed to copy paths" unless $saved-to; 28 | say "The following top level paths now exist:"; 29 | say "\t{$_.Str}" for $saved-to.dir; 30 | 31 | my $extract-to = $*CWD.child("extracted_backup_dir"); 32 | my $extracted-to = $fetch-path.extract($saved-to, $extract-to); 33 | 34 | die "Failed to extract paths" unless $extracted-to; 35 | say "The following top level paths now exist:"; 36 | say "\t{$_.Str}" for $extracted-to.dir; 37 | 38 | =end code 39 | 40 | =head1 Description 41 | 42 | C and C class for handling local file paths. 43 | 44 | You probably never want to use this unless its indirectly through C or C; 45 | handling files will generally be easier using core language functionality. This class exists to provide 46 | the means for fetching local paths using the C and C interfaces that the e.g. git/http/tar 47 | fetching/extracting adapters use. 48 | 49 | =head1 Methods 50 | 51 | =head2 method probe 52 | 53 | method probe(--> Bool:D) 54 | 55 | Returns C if this module believes all run time prerequisites are met. Since the only prerequisite 56 | is a file system this always returns C 57 | 58 | =head2 method fetch-matcher 59 | 60 | method fetch-matcher(Str() $uri --> Bool:D) 61 | 62 | Returns C if this module knows how to fetch C<$uri>, which it decides based on if C<$uri> looks like 63 | a file path (i.e. C<$uri> starts with a C<.> or C) and if that file path exists. 64 | 65 | =head2 method extract-matcher 66 | 67 | method extract-matcher(Str() $uri --> Bool:D) 68 | 69 | Returns C if this module knows how to extract C<$uri>, which it decides based on if C<$uri> looks like 70 | a file path (i.e. C<$uri> starts with a C<.> or C) and if that file path exists as a directory. 71 | 72 | =head2 method fetch 73 | 74 | method fetch(IO() $source-path, IO() $save-to, Supplier :$stdout, Supplier :$stderr --> IO::Path) 75 | 76 | Fetches the given C<$source-path> from the file system and copies it to C<$save-to> (+ timestamp if C<$source-path> 77 | is a directory) directory. A C can be supplied as C<:$stdout> and C<:$stderr> to receive any output. 78 | 79 | On success it returns the C where the data was actually saved to (usually a subdirectory under the passed-in 80 | C<$save-to>). On failure it returns C. 81 | 82 | =head2 method extract 83 | 84 | method extract(IO() $source-path, IO() $save-to, Supplier :$stdout, Supplier :$stderr --> IO::Path) 85 | 86 | Extracts the given C<$source-path> from the file system and copies it to C<$save-to>. A C can be 87 | supplied as C<:$stdout> and C<:$stderr> to receive any output. 88 | 89 | On success it returns the C where the data was actually extracted to. On failure it returns C. 90 | 91 | =head2 method ls-files 92 | 93 | method ls-files(IO() $path --> Array[Str]) 94 | 95 | On success it returns an C of relative paths that are available to be extracted from C<$path>. 96 | 97 | =end pod 98 | 99 | 100 | #| Always return true since a file system is required 101 | method probe(--> Bool:D) { return True } 102 | 103 | #| Return true if this Fetcher understands the given uri/path 104 | method fetch-matcher(Str() $uri --> Bool:D) { 105 | # .is-absolute lets the app pass around absolute paths on windows and still work as expected 106 | my $is-pathy = so <. />.first({ $uri.starts-with($_) }) || $uri.IO.is-absolute; 107 | return so $is-pathy && $uri.IO.e; 108 | } 109 | 110 | #| Return true if this Extractor understands the given uri/path 111 | method extract-matcher(Str() $uri --> Bool:D) { 112 | # .is-absolute lets the app pass around absolute paths on windows and still work as expected 113 | my $is-pathy = so <. />.first({ $uri.starts-with($_) }) || $uri.IO.is-absolute; 114 | return so $is-pathy && $uri.IO.d; 115 | } 116 | 117 | #| Fetch (copy) the given source path to the $save-to (+ timestamp if source-path is a directory) directory 118 | method fetch(IO() $source-path, IO() $save-to, Supplier :$stdout, Supplier :$stderr --> IO::Path) { 119 | return Nil if !$source-path.e; 120 | return $source-path if $source-path.absolute eq $save-to.absolute; # fakes a fetch 121 | my $dest-path = $source-path.d ?? $save-to.child("{$source-path.IO.basename}_{time}") !! $save-to; 122 | mkdir($dest-path) if $source-path.d && !$save-to.e; 123 | return $dest-path if copy-paths($source-path, $dest-path).elems; 124 | return Nil; 125 | } 126 | 127 | #| Extract (copy) the files located in $source-path directory to $save-to directory. 128 | #| This is mostly the same as fetch, and essentially allows the workflow to treat 129 | #| any uri type (including paths) as if they can be extracted. 130 | method extract(IO() $source-path, IO() $save-to, Supplier :$stdout, Supplier :$stderr --> IO::Path) { 131 | my $extracted-to = $save-to.child($source-path.basename); 132 | my @extracted = copy-paths($source-path, $extracted-to); 133 | return +@extracted ?? $extracted-to !! Nil; 134 | } 135 | 136 | #| List all files and directories, recursively, for the given path 137 | method ls-files(IO() $path --> Array[Str]) { 138 | my Str @results = list-paths($path, :f, :!d, :r).map(*.Str); 139 | return @results; 140 | } 141 | } 142 | -------------------------------------------------------------------------------- /t/utils-filesystem.rakutest: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Test; 3 | plan 4; 4 | 5 | use Zef::Utils::FileSystem; 6 | 7 | my $save-to = $*TMPDIR.child(time); 8 | my $dir-id = 0; 9 | 10 | # :d :f :r 11 | subtest "list-paths and delete-paths :d :f :r (rm -rf)" => { 12 | temp $save-to = $save-to.child(++$dir-id); 13 | my @delete-us; 14 | 15 | # 1. Folder: /{temp folder} 16 | # 2. File: /{temp folder}/base-delete.me 17 | # 3. Folder: /{temp folder}/deleteme-subfolder 18 | # 4. File: /{temp folder}/deleteme-subfolder/base-delete.me 19 | # All 4 items should get deleted 20 | 21 | mkdir($_) and @delete-us.append($_) with ~$save-to; 22 | my $sub-folder = $save-to.child('deleteme-subfolder'); 23 | mkdir($_) and @delete-us.append($_) with ~$sub-folder; 24 | 25 | # create 2 test files, one in each directory we created above 26 | my $save-to-file = $save-to.child('base-delete.me'); 27 | my $sub-folder-file = $sub-folder.child('sub-delete.me'); 28 | $save-to-file.spurt(time); 29 | $sub-folder-file.spurt(time); 30 | @delete-us.append($save-to-file.path); 31 | @delete-us.append($sub-folder-file.path); 32 | 33 | ok $save-to.d, "Folder available to delete"; 34 | 35 | my @paths = list-paths($save-to, :f, :d, :r); 36 | my @deleted = delete-paths($save-to, :f, :d, :r); 37 | 38 | is +@deleted, +@paths + 1; 39 | 40 | my $to-be-deleted = any($save-to, $sub-folder, $save-to-file, $sub-folder-file); 41 | for @delete-us -> $path-to-delete { 42 | is $path-to-delete, any(|@paths,$save-to), 'file was found in list-paths'; 43 | is $path-to-delete, $to-be-deleted, "Deleted: {$path-to-delete}"; 44 | } 45 | } 46 | 47 | 48 | # :d :f 49 | subtest "list-paths and delete-paths :d :f (no recursion)" => { 50 | temp $save-to = $save-to.child(++$dir-id); 51 | 52 | my @delete-us; 53 | 54 | # 1. Folder: /{temp folder} 55 | # 2. File: /{temp folder}/base-delete.me 56 | # 3. Folder: /{temp folder}/deleteme-subfolder 57 | # 4. File: /{temp folder}/deleteme-subfolder/base-delete.me 58 | # Only item 2 should get deleted 59 | 60 | my $sub-folder = $save-to.child('deleteme-subfolder'); 61 | mkdir($sub-folder); 62 | 63 | # create 2 test files, one in each directory we created above 64 | my $save-to-file = $save-to.child('base-delete.me'); 65 | my $sub-folder-file = $sub-folder.child('sub-delete.me'); 66 | $save-to-file.spurt(time); 67 | $sub-folder-file.spurt(time); 68 | @delete-us.append($save-to-file); 69 | 70 | ok $save-to.d, "Folder available to delete"; 71 | 72 | my @paths = list-paths($save-to, :d, :f); 73 | my @deleted = delete-paths($save-to, :d, :f); 74 | 75 | is +@deleted, +@paths + 1; 76 | 77 | my $to-be-deleted = any($save-to-file); 78 | my $not-deleted = any($save-to, $sub-folder, $sub-folder-file); 79 | 80 | for @delete-us -> $path-to-delete { 81 | is $path-to-delete, any(@paths), "File was found in list-paths"; 82 | is $path-to-delete, $to-be-deleted, "Deleted: {$path-to-delete.path}"; 83 | isnt $path-to-delete, $not-deleted, 'Did not delete sub-file or delete non-empty directory'; 84 | } 85 | } 86 | 87 | 88 | # :d :r 89 | subtest "list-paths and delete-paths :d :r" => { 90 | temp $save-to = $save-to.child(++$dir-id); 91 | 92 | my @delete-us; 93 | 94 | # 1. Folder: /{temp folder} 95 | # 2. File: /{temp folder}/base-delete.me 96 | # 3. Folder: /{temp folder}/deleteme-subfolder 97 | # 4. File: /{temp folder}/deleteme-subfolder/base-delete.me 98 | # 5. Folder /{temp folder}/empty-subfolder 99 | # Only item 5 will be deleted 100 | 101 | my $sub-folder = $save-to.child('deleteme-subfolder'); 102 | mkdir($sub-folder); 103 | my $sub-folder-empty = $save-to.child('empty-subfolder'); 104 | @delete-us.append($sub-folder-empty); 105 | mkdir($sub-folder-empty); 106 | 107 | # create 2 test files, one in each directory we created above 108 | my $save-to-file = $save-to.child('base-delete.me'); 109 | my $sub-folder-file = $sub-folder.child('sub-delete.me'); 110 | $save-to-file.spurt(time); 111 | $sub-folder-file.spurt(time); 112 | 113 | ok $save-to.d, "Folder available to delete"; 114 | 115 | my @paths = list-paths($save-to, :d, :r); 116 | my @deleted = delete-paths($save-to, :d, :r); 117 | 118 | is +@deleted, +@paths + 1; 119 | 120 | my $to-be-deleted = any($sub-folder-empty); 121 | my $not-deleted = any($save-to, $save-to-file, $sub-folder, $sub-folder-file); 122 | for @delete-us -> $path-to-delete { 123 | is $path-to-delete, any(@paths), "File was found in list-paths"; 124 | is $path-to-delete, $to-be-deleted, "Deleted: {$path-to-delete.path}"; 125 | isnt $path-to-delete, $not-deleted, 'Did not delete sub-file or delete non-empty directory'; 126 | } 127 | } 128 | 129 | 130 | # :f :r 131 | subtest "list-paths and delete-paths :f :r" => { 132 | temp $save-to = $save-to.child(++$dir-id); 133 | 134 | my @delete-us; 135 | 136 | # 1. Folder: /{temp folder} 137 | # 2. File: /{temp folder}/base-delete.me 138 | # 3. Folder: /{temp folder}/deleteme-subfolder 139 | # 4. File: /{temp folder}/deleteme-subfolder/base-delete.me 140 | # 5. Folder /{temp folder}/empty-subfolder 141 | # Delete items 2 and 4 142 | 143 | my $sub-folder = $save-to.child('deleteme-subfolder'); 144 | mkdir($sub-folder); 145 | my $sub-folder-empty = $save-to.child('empty-subfolder'); 146 | mkdir($sub-folder-empty); 147 | 148 | # create 2 test files, one in each directory we created above 149 | my $save-to-file = $save-to.child('base-delete.me'); 150 | my $sub-folder-file = $sub-folder.child('sub-delete.me'); 151 | $save-to-file.spurt(time); 152 | $sub-folder-file.spurt(time); 153 | @delete-us.append($save-to-file); 154 | @delete-us.append($sub-folder-file); 155 | 156 | ok $save-to.d, "Folder available to delete"; 157 | 158 | my @paths = list-paths($save-to, :f, :r); 159 | my @deleted = delete-paths($save-to, :f, :r); 160 | 161 | is +@deleted, +@paths + 3; 162 | 163 | my $to-be-deleted = any($save-to-file, $sub-folder-file); 164 | my $not-deleted = any($save-to, $sub-folder, $sub-folder-empty); 165 | for @delete-us -> $path-to-delete { 166 | is $path-to-delete, any(@paths), "File was found in list-paths"; 167 | is $path-to-delete, $to-be-deleted, "Deleted: {$path-to-delete.path}"; 168 | isnt $path-to-delete, $not-deleted, 'Did not delete sub-file or delete non-empty directory'; 169 | } 170 | } 171 | 172 | try rmdir($save-to); 173 | 174 | 175 | done-testing; 176 | -------------------------------------------------------------------------------- /lib/Zef/Distribution/Local.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Distribution:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | class Zef::Distribution::Local is Zef::Distribution { 6 | 7 | =begin pod 8 | 9 | =title class Zef::Distribution::Local 10 | 11 | =subtitle A local file system Distribution implementation 12 | 13 | =head1 Synopsis 14 | 15 | =begin code :lang 16 | 17 | use Zef::Distribution::Local; 18 | 19 | my $dist = Zef::Distribution::Local.new($*CWD); 20 | 21 | # Show the meta data 22 | say $dist.meta.raku; 23 | 24 | # Output the content of the first item in provides 25 | with $dist.meta.hash.values.head -> $name-path { 26 | say $dist.content($name-path).open.slurp; 27 | } 28 | 29 | # Output if the $dist contains a namespace matching Foo::Bar:ver<1> 30 | say $dist.contains-spec("Foo::Bar:ver<1>"); 31 | 32 | =end code 33 | 34 | =head1 Description 35 | 36 | A C implementation that is used to represent locally downloaded and extracted distributions. 37 | 38 | =head1 Methods 39 | 40 | =head2 method new 41 | 42 | method new(IO() $path) 43 | 44 | Create a C from a local distribution via its C file. 45 | If C<$path> is a directory then it will assume there is a C file it can use. 46 | If C<$path> is a file it will assume it a json file containing meta data (formatted like C). 47 | 48 | =head2 method meta 49 | 50 | method meta(--> Hash:D) 51 | 52 | Returns the meta data that represents the distribution. 53 | 54 | =head2 method content 55 | 56 | method content($name-path --> IO::Handle:D) 57 | 58 | Returns an unopened C that can be used to get the content of the C<$name-path>, where C<$name-path> 59 | is a value of the distributions C e.g. C, C<$dist.content($dist.meta{"Foo"})>. 60 | 61 | =end pod 62 | 63 | 64 | has $.path; 65 | has $.IO; 66 | 67 | #| Create a distribution from $path. 68 | #| If $path = dir/meta6.json, $.path is set to dir. 69 | #| If $path = dir/, $.path is set to the first meta file (if any) thats found. 70 | method new(IO() $path) { 71 | die "Cannot create a Zef::Distribution from non-existent path: {$path}" unless $path.e; 72 | my $meta-path = self!find-meta($path) || die "No meta file? Path: {$path}"; 73 | my $abspath = $meta-path.parent.absolute; 74 | my %meta = try { %(Zef::from-json($meta-path.slurp)) } || die "Invalid json? File: {$meta-path}"; 75 | my $IO = $abspath.IO; 76 | self.bless(:path($abspath), :$IO, |%(%meta.grep(?*.value.elems)), :meta(%meta)); 77 | } 78 | 79 | has %!meta-cache; 80 | #| Get the meta data this distribution provides 81 | method meta(--> Hash:D) { 82 | return %!meta-cache if %!meta-cache; 83 | my %hash = self.Zef::Distribution::meta; 84 | # These are required for installation, but not part of META6 spec 85 | # Eventually there needs to be a spec for authors to declare their bin scripts, 86 | # and CUR should probably handle the resources file mapping itself (since all 87 | # data needed to calculate it exists under the 'resources' field). 88 | %hash{"resources/" ~ .key} = .value for self!resources(:meta(%hash)).list; 89 | %hash{"bin/" ~ .key} = .value for self!scripts.list; 90 | return %!meta-cache := %hash; 91 | } 92 | 93 | #| Get a handle used to read/slurp data from files this distribution contains 94 | method content($name-path --> IO::Handle:D) { 95 | my $handle = IO::Handle.new: path => IO::Path.new($name-path, :CWD(self.IO)); 96 | return $handle // $handle.throw; 97 | } 98 | 99 | #| Given a path that might be a file or directory it makes a best guess at what the implied META6.json is. 100 | method !find-meta(Zef::Distribution::Local: $path? is copy --> IO::Path) { 101 | my $dir = $path ~~ IO::Path # Purpose: Turn whatever the user gives us to a IO::Path if possible 102 | ?? $path # - Already IO::Path 103 | !! $path.?chars # - If $path is Any it won't have .chars (hence .?chars) 104 | ?? $path.IO # - A string with at least 1 char is needed to call `.IO` 105 | !! self.IO; # - Assume its meant to be called on itself (todo: check $path.defined) 106 | 107 | # If a file was passed in then we assume its a metafile. Normally you'd pass 108 | # in a directory containing the meta file, but for convience we'll do this for files 109 | return $dir if !$dir || $dir.IO.f; 110 | 111 | # The windows path size check is for windows symlink wonkiness. 112 | # "12" is the minimum size required for a valid meta that 113 | # rakudos internal json parser can understand (and is longer than 114 | # what the symlink issue noted above usually involves) 115 | my $meta-file = $dir.add('META6.json'); 116 | return $meta-file.IO.e ?? $meta-file !! IO::Path; 117 | } 118 | 119 | #| Get all files in resources/ directory and map them into a hash CURI.install understands. 120 | method !resources(:%meta, Bool :$absolute --> Hash:D) { 121 | my $res-path = self.IO.child('resources'); 122 | 123 | # resources/libraries is treated differently than everything else. 124 | # It uses the internal platform-library-name method to apply an 125 | # automatic platform naming scheme to the paths. It maps the original 126 | # path to this new path so that CURI.install can understand it. 127 | # Example: 128 | # META FILE: 'resources/libraries/mylib' 129 | # GENERATED: 'resources/libraries/mylib' => 'resources/libaries/libmylib.so' 130 | # or 'resources/libraries/mylib' => 'resources/libaries/mylib.dll' 131 | # Note that it does not add the "lib" prefix on Windows. Whether the generated file has the "lib" prefix is platform dependent. 132 | my $lib-path = $res-path.child('libraries'); 133 | 134 | return %meta.grep(*.defined).map(-> $resource { 135 | my $resource-path = $resource ~~ m/^libraries\/(.+)/ 136 | ?? $lib-path.child($*VM.platform-library-name(IO::Path.new($0, :CWD($!path)))) 137 | !! $res-path.child($resource); 138 | $resource => $resource-path.IO.is-relative 139 | ?? ( ?$absolute ?? $resource-path.IO.absolute($!path) !! $resource-path ) 140 | !! ( !$absolute ?? $resource-path.IO.relative($!path) !! $resource-path ); 141 | }).hash; 142 | } 143 | 144 | #| Get all files in bin/ directory and map them into a hash CURI.install understands. 145 | method !scripts(Bool :$absolute --> Hash:D) { 146 | do with $.IO.child('bin') -> $bin { 147 | return $bin.dir.grep(*.IO.f).map({ 148 | $_.IO.basename => $_.IO.is-relative 149 | ?? ( ?$absolute ?? $_.IO.absolute($!path) !! $_ ) 150 | !! ( !$absolute ?? $_.IO.relative($!path) !! $_ ) 151 | }).hash if $bin.IO.d 152 | } 153 | return {}; 154 | } 155 | } 156 | -------------------------------------------------------------------------------- /lib/Zef/Service/Shell/tar.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | 4 | # Note: when passing command line arguments to tar in this module be sure to use relative 5 | # paths. ex: set :cwd to $archive-file.parent, and use $archive-file.basename as the target 6 | # This is because gnu tar on windows can't handle a windows style volume in path arguments 7 | class Zef::Service::Shell::tar does Extractor { 8 | 9 | =begin pod 10 | 11 | =title class Zef::Service::Shell::tar 12 | 13 | =subtitle A tar based implementation of the Extractor interface 14 | 15 | =head1 Synopsis 16 | 17 | =begin code :lang 18 | 19 | use Zef; 20 | use Zef::Service::Shell::tar; 21 | 22 | my $tar = Zef::Service::Shell::tar.new; 23 | 24 | # Assuming a zef-main.tar.gz file is in the cwd... 25 | my $source = $*HOME.child("zef-main.tar.gz"); 26 | my $extract-to = $*TMPDIR.child(time); 27 | my $extracted-to = $tar.extract($source, $extract-to); 28 | 29 | die "Something went wrong" unless $extracted-to; 30 | say "Zef META6 from HEAD: "; 31 | say $extracted-to.child("zef-main/META6.json").slurp; 32 | 33 | =end code 34 | 35 | =head1 Description 36 | 37 | C class for handling file based URIs ending in .tar.gz / .tgz using the C command. If bsdtar is 38 | used it will also work on C<.zip> files. 39 | 40 | You probably never want to use this unless its indirectly through C; 41 | handling files and spawning processes will generally be easier using core language functionality. This 42 | class exists to provide the means for fetching a file using the C interfaces that the e.g. git/unzip 43 | adapters use. 44 | 45 | =head1 Methods 46 | 47 | =head2 method probe 48 | 49 | method probe(--> Bool:D) 50 | 51 | Returns C if this module can successfully launch the C command. 52 | 53 | =head2 method extract-matcher 54 | 55 | method extract-matcher(Str() $uri --> Bool:D) 56 | 57 | Returns C if this module knows how to extract C<$uri>, which it decides based on if C<$uri> is 58 | an existing local file and ends with C<.tar.gz> or C<.tgz>. If bsdtar is used it will also work on 59 | C<.zip> files. 60 | 61 | =head2 method extract 62 | 63 | method extract(IO() $archive-file, IO() $extract-to, Supplier :$stdout, Supplier :$stderr --> IO::Path) 64 | 65 | Extracts the files in C<$archive-file> to C<$save-to> via the C command. A C can be supplied 66 | as C<:$stdout> and C<:$stderr> to receive any output. 67 | 68 | On success it returns the C where the data was actually extracted to. On failure it returns C. 69 | 70 | =head2 method ls-files 71 | 72 | method ls-files(IO() $archive-file, Supplier :$stdout, Supplier :$stderr --> Array[Str]) 73 | 74 | On success it returns an C of relative paths that are available to be extracted from C<$archive-file>. 75 | A C can be supplied as C<:$stdout> and C<:$stderr> to receive any output. 76 | 77 | =end pod 78 | 79 | my Lock $probe-lock = Lock.new; 80 | my Bool $probe-cache; 81 | my Str @extract-matcher-extensions = '.tar.gz', '.tgz'; 82 | 83 | #| Return true if the `tar` command is available to use 84 | method probe(--> Bool:D) { 85 | $probe-lock.protect: { 86 | return $probe-cache if $probe-cache.defined; 87 | 88 | # OpenBSD tar doesn't have a --help flag so we can't probe 89 | # using that, and we need the --help output to detect if 90 | # it can support .zip files. So we have a special case to 91 | # probe for tar on OpenBSD (which doesn't support .zip). 92 | if BEGIN $*VM.osname.lc.contains('openbsd') { 93 | # On OpenBSD `tar -cf -` should run successfully with no 94 | # output. This would cause a warning with GNU tar. 95 | my $proc = Zef::zrun('tar', '-cf', '-', :!out, :!err); 96 | return $probe-cache = so $proc; 97 | } 98 | 99 | my $proc = Zef::zrun('tar', '--help', :out, :!err); 100 | my $probe is default(False) = try so $proc; 101 | @extract-matcher-extensions.push('.zip') if $proc.out.slurp(:close).contains('bsdtar'); 102 | return $probe-cache = $probe; 103 | } 104 | } 105 | 106 | #| Return true if this Extractor understands the given uri/path 107 | method extract-matcher(Str() $uri --> Bool:D) { 108 | $probe-lock.protect: { # protect the read on @extract-matcher-extensions 109 | self.probe(); # prime @extract-matcher-extensions 110 | return so @extract-matcher-extensions.first({ $uri.lc.ends-with($_) }); 111 | } 112 | } 113 | 114 | #| Extract the given $archive-file 115 | method extract(IO() $archive-file, IO() $extract-to, Supplier :$stdout, Supplier :$stderr --> IO::Path) { 116 | die "archive file does not exist: {$archive-file.absolute}" 117 | unless $archive-file.e && $archive-file.f; 118 | die "target extraction directory {$extract-to.absolute} does not exist and could not be created" 119 | unless ($extract-to.e && $extract-to.d) || mkdir($extract-to); 120 | 121 | my $passed; 122 | react { 123 | my $cwd := $archive-file.parent; 124 | my $ENV := %*ENV; 125 | my $proc = Zef::zrun-async('tar', '-zxvf', self!cli-path($archive-file.basename), '-C', $extract-to.relative($cwd)); 126 | $stdout.emit("Command: {$proc.command}"); 127 | whenever $proc.stdout(:bin) { } 128 | whenever $proc.stderr(:bin) { } 129 | whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } 130 | } 131 | 132 | return $passed ?? $extract-to !! Nil; 133 | } 134 | 135 | #| Returns an array of strings, where each string is a relative path representing a file that can be extracted from the given $archive-file 136 | method ls-files(IO() $archive-file, Supplier :$stdout, Supplier :$stderr) { 137 | die "archive file does not exist: {$archive-file.absolute}" 138 | unless $archive-file.e && $archive-file.f; 139 | 140 | my $passed; 141 | my $output = Buf.new; 142 | react { 143 | my $cwd := $archive-file.parent; 144 | my $ENV := %*ENV; 145 | my $proc = Zef::zrun-async('tar', '-zt', '-f', self!cli-path($archive-file.basename)); 146 | $stdout.emit("Command: {$proc.command}"); 147 | whenever $proc.stdout(:bin) { $output.append($_) } 148 | whenever $proc.stderr(:bin) { } 149 | whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } 150 | } 151 | 152 | my @extracted-paths = $output.decode.lines; 153 | $passed ?? @extracted-paths.grep(*.defined) !! (); 154 | } 155 | 156 | # Workaround for https://github.com/ugexe/zef/issues/444 157 | # We could alternative use --force-local but that requires figuring out which 158 | # flavor of tar we're using. 159 | # Expects $path to already be a relative path string (not an absolute path) 160 | method !cli-path(Str $path --> Str) { 161 | return $path if <./ ../ .\\ ..\\>.grep({ $path.starts-with($_) }); 162 | return './' ~ $path; 163 | } 164 | } 165 | -------------------------------------------------------------------------------- /lib/Zef/Utils/FileSystem.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | module Zef::Utils::FileSystem { 4 | 5 | =begin pod 6 | 7 | =title module Zef::Utils::FileSystem 8 | 9 | =subtitle Utility subroutines for interacting with the file system 10 | 11 | =head1 Synopsis 12 | 13 | =begin code :lang 14 | 15 | use Zef::Utils::FileSystem; 16 | 17 | # Recursively list, copy, move, or delete paths 18 | my @files_in_lib = list-paths("lib/"); 19 | my @copied_to_lib2 = copy-paths("lib/", "lib2/"); 20 | my @moved_to_lib3 = move-paths("lib2/", "lib3/"); 21 | my @deleted_from_lib3 = delete-paths("lib3/"); 22 | 23 | # Locate a bin script from $PATH 24 | my $zef_in_path = Zef::Utils::FileSystem::which("zef"); 25 | say "zef bin location: {$zef_in_path // 'n/a'}"; 26 | 27 | # A Lock.protect like interface that is backed by a file lock 28 | my $lock-file = $*TMP.add("myapp.lock"); 29 | lock-file-protect($lock-file, { 30 | # do some work here that may want to use cross-process locking 31 | }); 32 | 33 | =end code 34 | 35 | =head1 Description 36 | 37 | Provides additional facilities for interacting with the file system. 38 | 39 | =head1 Subroutines 40 | 41 | =head2 sub list-paths 42 | 43 | sub list-paths(IO() $path, Bool :$d, Bool :$f = True, Bool :$r = True, Bool :$dot --> Array[IO::Path]) 44 | 45 | Returns an C of C of all paths under C<$path>. 46 | 47 | If C<:$d> is C directories will be returned. 48 | 49 | If C<$f> is set to C then files will not be returned. 50 | 51 | If C<$r> is set to C it will not recurse into directories. 52 | 53 | If C<$dot> is C then the current directory may be included in the return results. 54 | 55 | =head2 sub copy-paths 56 | 57 | sub copy-paths(IO() $from-path, IO() $to-path, Bool :$d, Bool :$f = True, Bool :$r = True, Bool :$dot --> Array[IO::Path]) 58 | 59 | Copy all paths under C<$from-path> to a directory C<$to-path> and returns an C of C of the successfully 60 | copied files (their new locations). 61 | 62 | If C<:$d> is C directories without files may be created. 63 | 64 | If C<$f> is set to C then files will not be copied. 65 | 66 | If C<$r> is C it will not recurse into directories. 67 | 68 | If C<$dot> is C then the current directory may be copied. 69 | 70 | =head2 sub move-paths 71 | 72 | sub move-paths(IO() $from-path!, IO() $to-path, Bool :$d, Bool :$f = True, Bool :$r = True, Bool :$dot --> Array[IO::Path]) 73 | 74 | Move all paths under C<$from-path> to a directory C<$to-path> and returns an C of C of the successfully 75 | moved files (their new locations). 76 | 77 | If C<:$d> is C directories without files won't be created. 78 | 79 | If C<$f> is set to C then files will not be moved. 80 | 81 | If C<$r> is C it will not recurse into directories. If C<$dot> is C then the current directory may be moved. 82 | 83 | =head2 sub delete-paths 84 | 85 | sub delete-paths(IO() $path!, Bool :$d, Bool :$f = True, Bool :$r = True, Bool :$dot --> Array[IO::Path]) 86 | 87 | Delete all paths under C<$path> and returns an C of C of what was deleted. 88 | 89 | If C<:$d> is C directories without files won't be deleted. 90 | 91 | If C<$f> is set to C then files will not be deleted. 92 | 93 | If C<$r> is C it will not recurse into directories. 94 | 95 | If C<$dot> is C then the current directory may be deleted. 96 | 97 | =head2 sub file-lock-protect 98 | 99 | sub lock-file-protect(IO() $path, &code, Bool :$shared = False) 100 | 101 | Provides an interface similar to C that is backed by a file lock on C<$path> instead of a semaphore. 102 | Its purpose is to help keep multiple instances of zef from trying to edit the e.g. p6c/cpan ecosystem index at the 103 | same time (although how well it serves that purpose in practice is unknown). 104 | 105 | =head2 sub which 106 | 107 | our sub which(Str $name --> Array[IO::Path]) 108 | 109 | Search the current env C, returning an C of C with paths that contain a matching file C<$name>. 110 | This is used for determining if a dependency such as C> is installed. 111 | 112 | =end pod 113 | 114 | sub list-paths(IO() $path, Bool :$d, Bool :$f = True, Bool :$r = True, Bool :$dot --> Array[IO::Path]) is export { 115 | die "{$path} does not exists" unless $path.e; 116 | my &wanted-paths := -> @_ { grep { .basename.starts-with('.') && !$dot ?? 0 !! 1 }, @_ } 117 | 118 | my IO::Path @results = gather { 119 | my @stack = $path.f ?? $path !! dir($path); 120 | while @stack.splice -> @paths { 121 | for wanted-paths(@paths) -> IO() $current { 122 | take $current if ($current.f && ?$f) || ($current.d && ?$d); 123 | @stack.append(dir($current)) if ?$r && $current.d; 124 | } 125 | } 126 | } 127 | return @results; 128 | } 129 | 130 | sub copy-paths(IO() $from-path, IO() $to-path, Bool :$d, Bool :$f = True, Bool :$r = True, Bool :$dot --> Array[IO::Path]) is export { 131 | die "{$from-path} does not exists" unless $from-path.IO.e; 132 | mkdir($to-path) if $from-path.d && !$to-path.e; 133 | 134 | my IO::Path @results = eager gather for list-paths($from-path, :$d, :$f, :$r, :$dot).sort -> $from-file { 135 | my $from-relpath = $from-file.relative($from-path); 136 | my $to-file = IO::Path.new($from-relpath, :CWD($to-path)).resolve; 137 | mkdir($to-file.parent) unless $to-file.e; 138 | take $to-file if copy($from-file, $to-file); 139 | } 140 | return @results; 141 | } 142 | 143 | sub move-paths(IO() $from-path, IO() $to-path, Bool :$d = True, Bool :$f = True, Bool :$r = True, Bool :$dot --> Array[IO::Path]) is export { 144 | my IO::Path @copied = copy-paths($from-path, $to-path, :$d, :$f, :$r, :$dot); 145 | @ = delete-paths($from-path, :$d, :$f, :$r, :$dot); 146 | return @copied; 147 | } 148 | 149 | sub delete-paths(IO() $path, Bool :$d = True, Bool :$f = True, Bool :$r = True, Bool :$dot = True --> Array[IO::Path]) is export { 150 | my @paths = list-paths($path, :$d, :$f, :$r, :$dot).unique(:as(*.absolute)); 151 | my @files = @paths.grep(*.f); 152 | my @dirs = @paths.grep(*.d); 153 | $path.f ?? @files.push($path.IO) !! @dirs.push($path.IO); 154 | 155 | my IO::Path @results = eager gather { 156 | for @files.sort(*.chars).reverse { take $_ if try unlink($_) } 157 | for @dirs.sort(*.chars).reverse { take $_ if try rmdir($_) } 158 | } 159 | return @results; 160 | } 161 | 162 | sub lock-file-protect(IO() $path, &code, Bool :$shared = False) is export { 163 | do given ($shared ?? $path.IO.open(:r) !! $path.IO.open(:w)) { 164 | LEAVE {.close} 165 | LEAVE {try .path.unlink} 166 | .lock(:$shared); 167 | code(); 168 | } 169 | } 170 | 171 | our sub which(Str $name --> Array[IO::Path]) { 172 | my $source-paths := $*SPEC.path.grep(*.?chars).map(*.IO).grep(*.d); 173 | my $path-guesses := $source-paths.map({ $_.child($name) }); 174 | my $possibilities := $path-guesses.map(-> $path { 175 | ((BEGIN $*DISTRO.is-win) 176 | ?? ($path.absolute, %*ENV.split(';').map({ $path.absolute ~ $_ })) 177 | !! $path.absolute) 178 | }); 179 | 180 | my IO::Path @results = $possibilities.flat.grep(*.defined).grep(*.IO.f).map(*.IO); 181 | return @results; 182 | } 183 | } 184 | -------------------------------------------------------------------------------- /lib/Zef/Extract.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Utils::FileSystem:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | 5 | class Zef::Extract does Extractor does Pluggable { 6 | 7 | =begin pod 8 | 9 | =title class Zef::Extract 10 | 11 | =subtitle A configurable implementation of the Extractor interface 12 | 13 | =head1 Synopsis 14 | 15 | =begin code :lang 16 | 17 | use Zef; 18 | use Zef::Extract; 19 | 20 | # Setup with a single extractor backend 21 | my $extractor = Zef::Extract.new( 22 | backends => [ 23 | { module => "Zef::Service::Shell::tar" }, 24 | ], 25 | ); 26 | 27 | # Save the content of $uri to $save-to 28 | my $tar-file = $*CWD.add("zef-v0.9.4.tar.gz"); 29 | my $candidate = Candidate.new(uri => $tar-file); 30 | my $extract-to = $*CWD.add("my-extract-dir"); 31 | 32 | # Show what files an archive contains 33 | say "About to extract the following paths:"; 34 | say "\t{$_}" for $extractor.ls-files($candidate); 35 | 36 | # Extract the archive 37 | my $extracted-to = $extractor.extract($candidate, $extract-to); 38 | say $extracted-to ?? "Done" !! "Something went wrong..."; 39 | 40 | =end code 41 | 42 | =head1 Description 43 | 44 | An C that uses 1 or more other C instances as backends. It abstracts the logic 45 | to do 'extract this path with the first backend that supports the given path'. 46 | 47 | =head1 Methods 48 | 49 | =head2 method extract-matcher 50 | 51 | method extract-matcher($path --> Bool:D) 52 | 53 | Returns C if any of the probeable C know how to extract C<$path>. 54 | 55 | =head2 method extract 56 | 57 | method extract(Candidate $candi, IO() $extract-to, Supplier :$logger, Int :$timeout --> IO::Path) 58 | 59 | Extracts the files for C<$candi> (usually as C<$candi.uri>) to C<$extract-to>. If a backend fails to extract 60 | for some reason (such as going over its C<:$timeout>) the next matching backend will be used. Failure occurs 61 | when no backend was able to extract the C<$candi>. 62 | 63 | An optional C<:$logger> can be supplied to receive events about what is occurring. 64 | 65 | An optional C<:$timeout> can be passed to denote the number of seconds after which we'll assume failure. 66 | 67 | On success it returns the C where the data was actually extracted to. On failure it returns C. 68 | 69 | Note this differs from other 'Extractor' adapters C (i.e. the extractors this uses as backends) which 70 | take a C as the first parameter, not a C. 71 | 72 | =head2 method ls-files 73 | 74 | method ls-files(IO() $archive-file, Supplier :$logger --> Array[Str]) 75 | 76 | On success it returns an C of relative paths that are available to be extracted from C<$archive-file>. 77 | 78 | An optional C<:$logger> can be supplied to receive events about what is occurring. 79 | 80 | =end pod 81 | 82 | 83 | submethod TWEAK(|) { 84 | @ = self.plugins; # preload plugins 85 | } 86 | 87 | #| Returns true if any of the backends 'extract-matcher' understand the given uri/path 88 | method extract-matcher($path --> Bool:D) { return so self!extract-matcher($path) } 89 | 90 | #| Returns the backends that understand the given uri based on their extract-matcher result 91 | method !extract-matcher($path --> Array[Extractor]) { 92 | my @matching-backends = self.plugins.grep(*.extract-matcher($path)); 93 | 94 | my Extractor @results = @matching-backends; 95 | return @results; 96 | } 97 | 98 | #| A helper method to deliver the 'missing backends' suggestions for extractors 99 | method !extractors($path --> Array[Extractor]) { 100 | my @extractors = self!extract-matcher($path).cache; 101 | 102 | unless +@extractors { 103 | my @report_enabled = self.plugins.map(*.short-name); 104 | my @report_disabled = self.backends.map(*.).grep({ $_ ~~ none(@report_enabled) }); 105 | 106 | die "Enabled extracting backends [{@report_enabled}] don't understand $path\n" 107 | ~ "You may need to configure one of the following backends, or install its underlying software - [{@report_disabled}]"; 108 | } 109 | 110 | my Extractor @results = @extractors; 111 | return @results; 112 | } 113 | 114 | #| Will return the first successful result while attempting to extract the given $candi.uri 115 | method extract(Candidate $candi, IO() $extract-to, Supplier :$logger, Int :$timeout --> IO::Path) { 116 | my $path := $candi.uri; 117 | die "Can't extract non-existent path: {$path}" unless $path.IO.e; 118 | die "Can't extract to non-existent path: {$extract-to}" unless $extract-to.e || $extract-to.mkdir; 119 | 120 | my $stdout = Supplier.new; 121 | my $stderr = Supplier.new; 122 | if ?$logger { 123 | $stdout.Supply.act: -> $out { $logger.emit({ level => VERBOSE, stage => EXTRACT, phase => LIVE, candi => $candi, message => $out }) } 124 | $stderr.Supply.act: -> $err { $logger.emit({ level => ERROR, stage => EXTRACT, phase => LIVE, candi => $candi, message => $err }) } 125 | } 126 | 127 | my $extractors = self!extractors($path).map(-> $extractor { 128 | if ?$logger { 129 | $logger.emit({ level => DEBUG, stage => EXTRACT, phase => START, candi => $candi, message => "Extracting with plugin: {$extractor.^name}" }); 130 | } 131 | 132 | my $out = lock-file-protect("{$extract-to}.lock", -> { 133 | my $todo = start { try $extractor.extract($path, $extract-to, :$stdout, :$stderr) }; 134 | my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new); 135 | await Promise.anyof: $todo, $time-up; 136 | $logger.emit({ level => DEBUG, stage => EXTRACT, phase => LIVE, candi => $candi, message => "Extracting $path timed out" }) 137 | if ?$logger && $time-up.so && $todo.not; 138 | $todo.so ?? $todo.result !! Nil 139 | }); 140 | 141 | # really just saving $extractor for an error message later on. should do away with it later 142 | $extractor => $out; 143 | }); 144 | 145 | # gnu tar on windows doesn't always work as I expect, so try another plugin if extraction fails 146 | my $extracted-to = $extractors.grep({ 147 | $logger.emit({ level => WARN, stage => EXTRACT, phase => LIVE, candi => $candi, message => "Extracting with plugin {.key.^name} aborted." }) 148 | if ?$logger && !(.value.defined && .value.IO.e); 149 | .value.defined && .value.IO.e; 150 | }).map(*.value).head; 151 | 152 | $stdout.done(); 153 | $stderr.done(); 154 | 155 | die "something went wrong extracting {$path} to {$extract-to} with {$.plugins.join(',')}" unless $extracted-to.so && $extracted-to.IO.e; 156 | 157 | my IO::Path $result = $extracted-to.IO; 158 | return $result; 159 | } 160 | 161 | #| Will return the results first successful extraction, where the results are an array of strings, where 162 | #| each string is a relative path representing a file that can be extracted from the given $candi.uri 163 | #| Note this differs from other 'Extract' adapters .extract() which take a $uri as the first 164 | #| parameter, not a $candi 165 | method ls-files($candi, Supplier :$logger --> Array[Str]) { 166 | my $stdout = Supplier.new; 167 | my $stderr = Supplier.new; 168 | if ?$logger { 169 | $stdout.Supply.act: -> $out { $logger.emit({ level => VERBOSE, stage => EXTRACT, phase => LIVE, candi => $candi, message => $out }) } 170 | $stderr.Supply.act: -> $err { $logger.emit({ level => ERROR, stage => EXTRACT, phase => LIVE, candi => $candi, message => $err }) } 171 | } 172 | 173 | my $path := $candi.uri; 174 | my $extractors := self!extractors($path); 175 | my $name-paths := $extractors.map(*.ls-files($path, :$stdout, :$stderr)).first(*.defined).map(*.IO); 176 | my @files = $name-paths.map({ .is-absolute ?? $path.IO.child(.relative($path)).cleanup.relative($path) !! $_ }); 177 | 178 | $stdout.done(); 179 | $stderr.done(); 180 | 181 | my Str @results = @files.map(*.Str); 182 | return @results; 183 | } 184 | } 185 | -------------------------------------------------------------------------------- /lib/Zef/Utils/URI.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | class Zef::Utils::URI { 4 | has $.is-relative; 5 | has $.match; 6 | 7 | has $.scheme; 8 | has $.host; 9 | has $.port; 10 | has $.user-info; 11 | has $.path; 12 | has $.query; 13 | has $.fragment; 14 | 15 | my grammar URI { 16 | token URI-reference { || } 17 | token URI { ':' ['?' ]? ['#' ]? } 18 | token relative-ref { ['?' ]? ['#' ]? } 19 | token heir-part { 20 | || '//' 21 | || 22 | || 23 | || 24 | } 25 | token relative-part { 26 | || '//' 27 | || 28 | || 29 | || 30 | } 31 | 32 | token scheme { 33 | <.alpha> 34 | [ 35 | || <.alpha> 36 | || <.digit> 37 | || '+' 38 | || '-' 39 | || '.' 40 | ]* 41 | } 42 | 43 | token authority { [ '@']? [':' ]? } 44 | token userinfo { [<.unreserved> || <.pct-encoded> || <.sub-delims> || ':']* } 45 | token host { <.IP-literal> || <.IPv4address> || <.reg-name> } 46 | token IP-literal { '[' [<.IPv6address> || <.IPv6addrz> || <.IPvFuture>] ']' } 47 | token IPv6addz { <.IPv6address> '%25' <.ZoneID> } 48 | token ZoneID { [<.unreserved> || <.pct-encoded>]+ } 49 | token IPvFuture { 'v' <.xdigit>+ '.' [<.unreserved> || <.sub-delims> || ':']+ } 50 | token IPv6address { 51 | || [<.h16> ':'] ** 6 <.ls32> 52 | || '::' [<.h16> ':'] ** 5 <.ls32> 53 | || [ <.h16> ]? '::' [<.h16> ':'] ** 4 <.ls32> 54 | || [[<.h16> ':'] ** 0..1 <.h16> ]? '::' [<.h16> ':'] ** 3 <.ls32> 55 | || [[<.h16> ':'] ** 0..2 <.h16> ]? '::' [<.h16> ':'] ** 2 <.ls32> 56 | || [[<.h16> ':'] ** 0..3 <.h16> ]? '::' <.h16> ':' <.ls32> 57 | || [[<.h16> ':'] ** 0..4 <.h16> ]? '::' <.ls32> 58 | || [[<.h16> ':'] ** 0..5 <.h16> ]? '::' <.h16> 59 | || [[<.h16> ':'] ** 0..6 <.h16> ]? '::' 60 | } 61 | token h16 { <.xdigit> ** 1..4 } 62 | token ls32 { [<.h16> ':' <.h16>] || <.IPv4address> } 63 | token IPv4address { <.dec-octet> '.' <.dec-octet> '.' <.dec-octet> '.' <.decoctet> } 64 | token dec-octet { 65 | || <.digit> 66 | || [\x[31]..\x[39]] <.digit> 67 | || '1' <.digit> ** 2 68 | || '2' [\x[30]..\x[34]] <.digit> 69 | || '25' [\x[30]..\x[35]] 70 | } 71 | token reg-name { [<.unreserved> || <.pct-encoded> || <.sub-delims>]* } 72 | token port { <.digit>* } 73 | 74 | token path { 75 | || <.path-abempty> 76 | || <.path-absolute> 77 | || <.path-noscheme> 78 | || <.path-rootless> 79 | || <.path-empty> 80 | } 81 | token path-abempty { ['/' <.segment>]* } 82 | token path-absolute { '/' [<.segment-nz> ['/' <.segment>]*]? } 83 | token path-noscheme { <.segment-nz-nc> ['/' <.segment>]* } 84 | token path-rootless { <.segment-nz> ['/' <.segment>]* } 85 | token path-empty { <.pchar> ** 0 } 86 | token segment { <.pchar>* } 87 | token segment-nz { <.pchar>+ } 88 | token segment-nz-nc { [<.unreserved> || <.pct-encoded> || <.sub-delims>]+ } 89 | token pchar { <.unreserved> || <.pct-encoded> || <.sub-delims> || ':' || '@' } 90 | token query { [<.pchar> || '/' || '?']* } 91 | token fragment { [<.pchar> || '/' || '?']* } 92 | token pct-encoded { '%' <.xdigit> <.xdigit> } 93 | token unreserved { <.alpha> || <.digit> || < - . _ ~ > } 94 | token reserved { <.gen-delims> || <.sub-delims> } 95 | 96 | token gen-delims { < : / ? # [ ] @ > } 97 | token sub-delims { < ! $ & ' ( ) * + , ; = > } # ' <- fixes syntax highlighting 98 | 99 | } 100 | 101 | my grammar URI::File is URI { 102 | token TOP { } 103 | 104 | token file-URI { ":" [ "?" ]? } 105 | 106 | token scheme { "file" } 107 | 108 | token heir-part { "//"? || } 109 | 110 | token auth-path { [ ]? || || } 111 | 112 | token auth { [ "@" ]? } 113 | 114 | token local-path { || } 115 | 116 | token unc-path { "//" "/"? } 117 | 118 | token windows-path { } 119 | token drive-letter { [ ]? } 120 | token drive-marker { ":" || "|" } 121 | 122 | # XXX: this is a bit of a hack -- see: 123 | # https://github.com/ugexe/zef/issues/204#issuecomment-366957374 124 | token pchar { <.unreserved> || <.pct-encoded> || <.sub-delims> || ':' || '@' || ' ' } 125 | } 126 | 127 | method new($id is copy) { 128 | # prefix windows paths with `file://` so they get parsed as a 'uri' type identity. 129 | my $possible-file-uri = "{$id.starts-with('file://')??''!!'file://'}{$*DISTRO.is-win??$id.subst('\\','/',:g)!!$id}"; 130 | 131 | if URI::File.parse($possible-file-uri, :rule) -> $m { 132 | my $ap = $m.; 133 | my $volume = ~($ap.. // ''); # what IO::SPEC::Win32 understands 134 | my $path = ~($ap.. // $ap. // die "Could not parse path from: $id"); 135 | my $host = ~($ap. // ''); 136 | my $scheme = ~$m.; 137 | my $is-relative = $path.IO.is-relative || not $ap...defined; 138 | 139 | # because `|` is sometimes used as a windows volume separator in a file-URI 140 | my $normalized-path = $is-relative ?? $path !! $*SPEC.join($volume, $path, ''); 141 | self.bless( :match($m), :$is-relative, :$scheme, :$host, :path($normalized-path) ); 142 | } 143 | elsif URI.parse($id, :rule) -> $m { 144 | my $heir = $m.; 145 | my $auth = $heir.; 146 | self.bless( 147 | match => $m, 148 | is-relative => False, 149 | scheme => ~($m. // '').lc, 150 | host => ~($auth. // ''), 151 | port => ($auth. // Int).Int, 152 | user-info => ~($auth. // ''), 153 | path => ~($heir. // '/'), 154 | query => ~($m. // ''), 155 | fragment => ~($m. // ''), 156 | ); 157 | } 158 | elsif URI.parse($id, :rule) -> $m { 159 | self.bless( 160 | match => $m, 161 | is-relative => True, 162 | scheme => ~($m. // '').lc, 163 | path => ~($m. || '/'), 164 | query => ~($m. // ''), 165 | fragment => ~($m. // ''), 166 | ); 167 | } 168 | elsif $id ~~ /^(.+?) '@' (.+?) ':' (.*)/ and URI.parse("ssh\:\/\/$0\@$1\/$2", :rule) -> $m { 169 | my $heir = $m.; 170 | my $auth = $heir.; 171 | self.bless( 172 | match => $m, 173 | is-relative => False, 174 | scheme => ~($m. // '').lc, 175 | host => ~($auth. // ''), 176 | port => ($auth. // Int).Int, 177 | user-info => ~($auth. // ''), 178 | path => ~($heir. // '/'), 179 | query => ~($m. // ''), 180 | fragment => ~($m. // ''), 181 | ); 182 | } 183 | else { 184 | die "Cannot parse $id as an URI"; 185 | } 186 | } 187 | } 188 | 189 | sub uri(Str() $uri) is export(:internals) { try Zef::Utils::URI.new($uri) } 190 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The Artistic License 2.0 2 | 3 | Copyright (c) 2000-2006, The Perl Foundation. 4 | 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | This license establishes the terms under which a given free software 11 | Package may be copied, modified, distributed, and/or redistributed. 12 | The intent is that the Copyright Holder maintains some artistic 13 | control over the development of that Package while still keeping the 14 | Package available as open source and free software. 15 | 16 | You are always permitted to make arrangements wholly outside of this 17 | license directly with the Copyright Holder of a given Package. If the 18 | terms of this license do not permit the full use that you propose to 19 | make of the Package, you should contact the Copyright Holder and seek 20 | a different licensing arrangement. 21 | 22 | Definitions 23 | 24 | "Copyright Holder" means the individual(s) or organization(s) 25 | named in the copyright notice for the entire Package. 26 | 27 | "Contributor" means any party that has contributed code or other 28 | material to the Package, in accordance with the Copyright Holder's 29 | procedures. 30 | 31 | "You" and "your" means any person who would like to copy, 32 | distribute, or modify the Package. 33 | 34 | "Package" means the collection of files distributed by the 35 | Copyright Holder, and derivatives of that collection and/or of 36 | those files. A given Package may consist of either the Standard 37 | Version, or a Modified Version. 38 | 39 | "Distribute" means providing a copy of the Package or making it 40 | accessible to anyone else, or in the case of a company or 41 | organization, to others outside of your company or organization. 42 | 43 | "Distributor Fee" means any fee that you charge for Distributing 44 | this Package or providing support for this Package to another 45 | party. It does not mean licensing fees. 46 | 47 | "Standard Version" refers to the Package if it has not been 48 | modified, or has been modified only in ways explicitly requested 49 | by the Copyright Holder. 50 | 51 | "Modified Version" means the Package, if it has been changed, and 52 | such changes were not explicitly requested by the Copyright 53 | Holder. 54 | 55 | "Original License" means this Artistic License as Distributed with 56 | the Standard Version of the Package, in its current version or as 57 | it may be modified by The Perl Foundation in the future. 58 | 59 | "Source" form means the source code, documentation source, and 60 | configuration files for the Package. 61 | 62 | "Compiled" form means the compiled bytecode, object code, binary, 63 | or any other form resulting from mechanical transformation or 64 | translation of the Source form. 65 | 66 | 67 | Permission for Use and Modification Without Distribution 68 | 69 | (1) You are permitted to use the Standard Version and create and use 70 | Modified Versions for any purpose without restriction, provided that 71 | you do not Distribute the Modified Version. 72 | 73 | 74 | Permissions for Redistribution of the Standard Version 75 | 76 | (2) You may Distribute verbatim copies of the Source form of the 77 | Standard Version of this Package in any medium without restriction, 78 | either gratis or for a Distributor Fee, provided that you duplicate 79 | all of the original copyright notices and associated disclaimers. At 80 | your discretion, such verbatim copies may or may not include a 81 | Compiled form of the Package. 82 | 83 | (3) You may apply any bug fixes, portability changes, and other 84 | modifications made available from the Copyright Holder. The resulting 85 | Package will still be considered the Standard Version, and as such 86 | will be subject to the Original License. 87 | 88 | 89 | Distribution of Modified Versions of the Package as Source 90 | 91 | (4) You may Distribute your Modified Version as Source (either gratis 92 | or for a Distributor Fee, and with or without a Compiled form of the 93 | Modified Version) provided that you clearly document how it differs 94 | from the Standard Version, including, but not limited to, documenting 95 | any non-standard features, executables, or modules, and provided that 96 | you do at least ONE of the following: 97 | 98 | (a) make the Modified Version available to the Copyright Holder 99 | of the Standard Version, under the Original License, so that the 100 | Copyright Holder may include your modifications in the Standard 101 | Version. 102 | 103 | (b) ensure that installation of your Modified Version does not 104 | prevent the user installing or running the Standard Version. In 105 | addition, the Modified Version must bear a name that is different 106 | from the name of the Standard Version. 107 | 108 | (c) allow anyone who receives a copy of the Modified Version to 109 | make the Source form of the Modified Version available to others 110 | under 111 | 112 | (i) the Original License or 113 | 114 | (ii) a license that permits the licensee to freely copy, 115 | modify and redistribute the Modified Version using the same 116 | licensing terms that apply to the copy that the licensee 117 | received, and requires that the Source form of the Modified 118 | Version, and of any works derived from it, be made freely 119 | available in that license fees are prohibited but Distributor 120 | Fees are allowed. 121 | 122 | 123 | Distribution of Compiled Forms of the Standard Version 124 | or Modified Versions without the Source 125 | 126 | (5) You may Distribute Compiled forms of the Standard Version without 127 | the Source, provided that you include complete instructions on how to 128 | get the Source of the Standard Version. Such instructions must be 129 | valid at the time of your distribution. If these instructions, at any 130 | time while you are carrying out such distribution, become invalid, you 131 | must provide new instructions on demand or cease further distribution. 132 | If you provide valid instructions or cease distribution within thirty 133 | days after you become aware that the instructions are invalid, then 134 | you do not forfeit any of your rights under this license. 135 | 136 | (6) You may Distribute a Modified Version in Compiled form without 137 | the Source, provided that you comply with Section 4 with respect to 138 | the Source of the Modified Version. 139 | 140 | 141 | Aggregating or Linking the Package 142 | 143 | (7) You may aggregate the Package (either the Standard Version or 144 | Modified Version) with other packages and Distribute the resulting 145 | aggregation provided that you do not charge a licensing fee for the 146 | Package. Distributor Fees are permitted, and licensing fees for other 147 | components in the aggregation are permitted. The terms of this license 148 | apply to the use and Distribution of the Standard or Modified Versions 149 | as included in the aggregation. 150 | 151 | (8) You are permitted to link Modified and Standard Versions with 152 | other works, to embed the Package in a larger work of your own, or to 153 | build stand-alone binary or bytecode versions of applications that 154 | include the Package, and Distribute the result without restriction, 155 | provided the result does not expose a direct interface to the Package. 156 | 157 | 158 | Items That are Not Considered Part of a Modified Version 159 | 160 | (9) Works (including, but not limited to, modules and scripts) that 161 | merely extend or make use of the Package, do not, by themselves, cause 162 | the Package to be a Modified Version. In addition, such works are not 163 | considered parts of the Package itself, and are not subject to the 164 | terms of this license. 165 | 166 | 167 | General Provisions 168 | 169 | (10) Any use, modification, and distribution of the Standard or 170 | Modified Versions is governed by this Artistic License. By using, 171 | modifying or distributing the Package, you accept this license. Do not 172 | use, modify, or distribute the Package, if you do not accept this 173 | license. 174 | 175 | (11) If your Modified Version has been derived from a Modified 176 | Version made by someone other than you, you are nevertheless required 177 | to ensure that your Modified Version complies with the requirements of 178 | this license. 179 | 180 | (12) This license does not grant you the right to use any trademark, 181 | service mark, tradename, or logo of the Copyright Holder. 182 | 183 | (13) This license includes the non-exclusive, worldwide, 184 | free-of-charge patent license to make, have made, use, offer to sell, 185 | sell, import and otherwise transfer the Package with respect to any 186 | patent claims licensable by the Copyright Holder that are necessarily 187 | infringed by the Package. If you institute patent litigation 188 | (including a cross-claim or counterclaim) against any party alleging 189 | that the Package constitutes direct or contributory patent 190 | infringement, then this Artistic License to you shall terminate on the 191 | date that such litigation is filed. 192 | 193 | (14) Disclaimer of Warranty: 194 | THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS 195 | IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED 196 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR 197 | NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL 198 | LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL 199 | BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 200 | DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF 201 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 202 | -------------------------------------------------------------------------------- /lib/Zef.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | 3 | module Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // '') { 4 | our sub zrun(*@_, *%_) is export { run (|@_).grep(*.?chars), |%_ } 5 | our sub zrun-async(*@_, *%_) is export { Proc::Async.new( (|@_).grep(*.?chars), |%_ ) } 6 | 7 | # rakudo must be able to parse json, so it doesn't 8 | # make sense to require a dependency to parse it 9 | our sub from-json($text) { ::("Rakudo::Internals::JSON").from-json($text) } 10 | our sub to-json(|c) { ::("Rakudo::Internals::JSON").to-json(|c) } 11 | 12 | enum LEVEL is export ; 13 | 14 | # We have an entry called STAGING because STAGE was already taken by the enum. We 15 | # should improve this situation in the future. 16 | enum STAGE is export ; 17 | 18 | enum PHASE is export ; 19 | 20 | # Get a resource located at a uri and save it to the local disk 21 | role Fetcher is export { 22 | method fetch($uri, $save-as) { ... } 23 | method fetch-matcher($uri) { ... } 24 | } 25 | 26 | # As a post-hook to the default fetchers we will need to extract zip 27 | # files. `git` does this itself, so a git based Fetcher wouldn't need this 28 | # although we could possibly add `--no-checkout` to `git`s fetch and treat 29 | # Extract as the action of `--checkout $branch` (allowing us to "extract" 30 | # a specific version from a commit/tag) 31 | role Extractor is export { 32 | method extract($archive-file, $target-dir) { ... } 33 | method ls-files($archive-file) { ... } 34 | method extract-matcher($path) { ... } 35 | } 36 | 37 | # test a single file OR all the files in a directory (recursive optional) 38 | role Tester is export { 39 | method test($path, :@includes, :$stdout, :$stderr) { ... } 40 | method test-matcher($path) { ... } 41 | } 42 | 43 | role Builder is export { 44 | method build($dist, :@includes, :$stdout, :$stderr) { ... } 45 | method build-matcher($path) { ... } 46 | } 47 | 48 | role Installer is export { 49 | method install($dist, :$cur, :$force) { ... } 50 | method install-matcher($dist) { ... } 51 | } 52 | 53 | role Reporter is export { 54 | method report($dist) { ... } 55 | } 56 | 57 | role Candidate is export { 58 | has $.dist; 59 | has Str $.as; # Requested as (maybe a url, maybe an identity, maybe a path) 60 | has Str() $.from; # Recommended from (::Ecosystems, ::LocalCache) 61 | has Str() $.uri is rw; # url, file path, etc 62 | has $.build-results is rw; 63 | has $.test-results is rw; 64 | } 65 | 66 | role PackageRepository is export { 67 | # An identifier like .^name but intended to differentiate between instances of the same class 68 | # For instance: ::Ecosystems and ::Ecosystems which would otherwise share the 69 | # same .^name of ::Ecosystems 70 | method id { $?CLASS.^name.split('+', 2)[0] } 71 | 72 | # max-results is meant so we can :max-results(1) when we are interested in using it like 73 | # `.candidates` (i.e. 1 match per identity) so we can stop iterating search plugins earlier 74 | method search(:$max-results, *@identities, *%fields --> Iterable) { ... } 75 | 76 | # Optional method currently being called after a search/fetch 77 | # to assist ::Repository::LocalCache in updating its MANIFEST path cache. 78 | # The concept needs more thought, but for instance a GitHub related repositories 79 | # could commit changes or push to a remote branch, and (as is now) the cs 80 | # ::LocalCache to update MANIFEST so we don't *have* to do a recursive folder search 81 | # 82 | # method store(*@dists) { } 83 | 84 | # Optional method for listing available packages. For p6c style repositories 85 | # where we have an index file this is easy. For metacpan style where we 86 | # make a remote query not so much (maybe it could list the most recent X 87 | # modules... or maybe it just doesn't implement it at all) 88 | # method available { } 89 | 90 | # Optional method that tells a repository to 'sync' its database. 91 | # Useful for repositories that store the database / file locally. 92 | # Not useful for query based resolution e.g. metacpan 93 | # method update { } 94 | } 95 | 96 | # Used by the phase's loader (i.e Zef::Fetch) to test that the plugin can 97 | # be used. for instance, ::Shell wrappers probe via `cmd --help`. Note 98 | # that the result of .probe is cached by each phase loader 99 | role Probeable is export { 100 | method probe (--> Bool) { ... } 101 | } 102 | 103 | role Pluggable is export { 104 | #| Stringified module names to load as a plugin 105 | has @.backends; 106 | 107 | #| All the loaded @.backend objects 108 | has $!plugins; 109 | 110 | sub DEBUG($plugin, $message) { 111 | say "[Plugin - {$plugin // $plugin // qq||}] $message"\ 112 | if ?%*ENV; 113 | } 114 | 115 | method plugins(*@short-names) { 116 | my $all-plugins := self!list-plugins; 117 | return $all-plugins unless +@short-names; 118 | 119 | my @plugins; 120 | for $all-plugins -> @plugin-group { 121 | if @plugin-group.grep(-> $plugin { $plugin.short-name ~~ any(@short-names) }) -> @filtered-group { 122 | push @plugins, @filtered-group; 123 | } 124 | } 125 | return @plugins; 126 | } 127 | 128 | has $!list-plugins-lock = Lock.new; 129 | method !list-plugins(@backends = @!backends) { 130 | $!list-plugins-lock.protect: { 131 | return $!plugins if $!plugins.so; 132 | 133 | # @backends used to only be an array of hash. However now the ::Repository 134 | # section of the config an an array of an array of hash and thus the logic 135 | # below was adapted (it wasn't designed this way from the start). 136 | my @plugins; 137 | for @backends -> $backend { 138 | if $backend ~~ Hash { 139 | if self!try-load($backend) -> $class { 140 | push @plugins, $class; 141 | } 142 | } 143 | else { 144 | my @group; 145 | for @$backend -> $plugin { 146 | if self!try-load($plugin) -> $class { 147 | push @group, $class; 148 | } 149 | } 150 | push( @plugins, @group ) if +@group; 151 | } 152 | } 153 | return $!plugins := @plugins 154 | } 155 | } 156 | 157 | method !try-load(Hash $plugin) { 158 | use Zef::Identity:auth(Zef.^auth):api(Zef.^api):ver(Zef.^ver); 159 | my $identity = Zef::Identity.new($plugin); 160 | my $short-name = $identity.name; 161 | my $plugin-is-core = so $?DISTRIBUTION.meta{$short-name}:exists; 162 | my $auth-matcher = $identity.auth || do { $plugin-is-core ?? Zef.^auth !! True }; 163 | my $api-matcher = $identity.api || do { $plugin-is-core ?? Zef.^api !! True }; 164 | my $version-matcher = $identity.version || do { $plugin-is-core ?? Zef.^ver !! True }; 165 | my $dep-spec = CompUnit::DependencySpecification.new(:$short-name, :$auth-matcher, :$api-matcher, :$version-matcher); 166 | DEBUG($plugin, "Checking: {$short-name}"); 167 | 168 | # default to enabled unless `"enabled" : 0` 169 | if $plugin:exists && (!$plugin || $plugin eq "0") { 170 | DEBUG($plugin, "\t(SKIP) Not enabled"); 171 | return; 172 | } 173 | 174 | unless try $*REPO.need($dep-spec) { 175 | DEBUG($plugin, "\t(SKIP) Plugin could not be loaded"); 176 | return; 177 | } 178 | 179 | DEBUG($plugin, "\t(OK) Plugin loaded successful"); 180 | 181 | if ::($short-name).^find_method('probe') { 182 | unless ::($short-name).probe { 183 | DEBUG($plugin, "\t(SKIP) Probing failed"); 184 | return; 185 | } 186 | DEBUG($plugin, "\t(OK) Probing successful") 187 | } 188 | 189 | # add attribute `short-name` here to make filtering by name slightly easier 190 | # until a more elegant solution can be integrated into plugins themselves 191 | my $class = ::($short-name).new(|($plugin // []))\ 192 | but role :: { has $.short-name = $plugin // '' }; 193 | 194 | # make the class name more human readable for cli output, 195 | # i.e. Zef::Service::Shell::curl instead of Zef::Service::Shell::curl+{} 196 | $class.^set_name($short-name); 197 | 198 | unless ?$class { 199 | DEBUG($plugin, "(SKIP) Plugin unusable: initialization failure"); 200 | return; 201 | } 202 | 203 | DEBUG($plugin, "(OK) Plugin is now usable: {$short-name}"); 204 | return $class; 205 | } 206 | } 207 | } 208 | 209 | class X::Zef::UnsatisfiableDependency is Exception { 210 | method message() { 211 | 'Failed to resolve some missing dependencies' 212 | } 213 | } 214 | -------------------------------------------------------------------------------- /lib/Zef/Distribution.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Distribution::DependencySpecification:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | use Zef::Utils::SystemQuery:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 5 | 6 | class Zef::Distribution does Distribution is Zef::Distribution::DependencySpecification { 7 | 8 | =begin pod 9 | 10 | =title class Zef::Distribution 11 | 12 | =subtitle A generic Distribution implementation 13 | 14 | =head1 Synopsis 15 | 16 | =begin code :lang 17 | 18 | use Zef::Distribution; 19 | use JSON::Fast; 20 | 21 | my %meta = from-json("META6.json".IO.slurp); 22 | my $dist = Zef::Distribution.new(|%meta); 23 | 24 | # Show the meta data 25 | say $dist.meta.raku; 26 | 27 | # Output if the $dist contains a namespace matching Foo::Bar:ver<1> 28 | say $dist.contains-spec("Foo::Bar:ver<1>"); 29 | 30 | =end code 31 | 32 | =head1 Description 33 | 34 | A C implementation that is used to represent not-yet-downloaded distributions. 35 | Generally you should use this class using the C interface and not as a struct representation 36 | of META6 data -- i.e. use C<$dist.meta.hash{"version"}> instead of <$dist.ver>. These variations are a wart 37 | included mostly for backwards compatibility purposes (or just leftover from years of changes to e.g. C 38 | and friends). 39 | 40 | When using this class "best practice" would be to consider the following methods are the public api: 41 | C and C (the C interface methods), C, C, C, C, C, C, C 42 | 43 | =head1 Methods 44 | 45 | =head2 method meta 46 | 47 | method meta(--> Hash:D) 48 | 49 | Returns the meta data that represents the distribution. 50 | 51 | =head2 method content 52 | 53 | method content() 54 | 55 | Will always throw an exception. This class is primarily used to represent a distribution when all we have it meta data; use 56 | a class like C (which subclasses this class) if or when you need access to the content of files 57 | besides C. 58 | 59 | =head2 method depends-specs 60 | 61 | method depends-specs(--> Array[Zef::Distribution::DependencySpecification]) 62 | 63 | Return an C of C for the runtime dependencies of the distribution. 64 | 65 | =head2 method test-depends-specs 66 | 67 | method test-depends-specs(--> Array[Zef::Distribution::DependencySpecification]) 68 | 69 | Return an C of C for the test dependencies of the distribution. 70 | 71 | =head2 method depends-specs 72 | 73 | method build-depends-specs(--> Array[Zef::Distribution::DependencySpecification]) 74 | 75 | Return an C of C for the build dependencies of the distribution. 76 | 77 | =head2 method provides-specs 78 | 79 | method provides-specs(--> Array[Zef::Distribution::DependencySpecification]) 80 | 81 | Return an C of C for the namespaces in the distributions C. 82 | 83 | =head2 method provides-spec-matcher 84 | 85 | method provides-spec-matcher(Zef::Distribution::DependencySpecification $spec, :$strict --> Bool:D) { self.provides-specs.first({ ?$_.spec-matcher($spec, :$strict) }) } 86 | 87 | Returns C if C<$spec> matches any namespaces this distribution provides (but not the name of the distribution itself). 88 | If C<$strict> is C then partial name matches will be allowed (i.e. C matching C). 89 | 90 | =head2 method contains-spec 91 | 92 | multi method contains-spec(Str $spec, |c --> Bool:D) 93 | multi method contains-spec(Zef::Distribution::DependencySpecification $spec, Bool :$strict = True --> Bool:D) 94 | multi method contains-spec(Zef::Distribution::DependencySpecification::Any $spec, Bool :$strict = True --> Bool:D) 95 | 96 | Returns C if C<$spec> matches any namespace this distribution provides, including the name of the distribution itself. 97 | If C<$strict> is C then partial name matches will be allowed (i.e. C matching C). 98 | 99 | When given a C C<$spec> the C<$spec> will be turned into a C. 100 | 101 | =head2 method Str 102 | 103 | method Str(--> Str) 104 | 105 | Returns the explicit full name of the distribution, i.e. C -> C:auth<>:api<>> 106 | 107 | =head2 method id 108 | 109 | method id(--> Str) 110 | 111 | Returns a file system safe unique string identifier for the distribution. This is generally meant for internal use only. 112 | 113 | Note: This should not publicly be relied on for matching any C implementation details this may appear to be emulating. 114 | 115 | =end pod 116 | 117 | 118 | has $.meta-version; 119 | has $.name; 120 | has $.auth; 121 | has $.author; 122 | has $.authority; 123 | has $.api; 124 | has $.ver; 125 | has $.version; 126 | has $.description; 127 | has $.depends; 128 | has %.provides; 129 | has %.files; 130 | has $.source-url; 131 | has $.license; 132 | has $.build-depends; 133 | has $.test-depends; 134 | has @.resources; 135 | has %.support; 136 | has $.builder; 137 | 138 | has %!meta; 139 | 140 | # attach arbitrary data, like for topological sort, that won't be saved on install 141 | has %.metainfo is rw; 142 | 143 | method new(*%_) { self.bless(|%_, :meta(%_)) } 144 | 145 | submethod TWEAK(:%!meta, :@!resources --> Nil) { 146 | @!resources = @!resources.map(*.flat); 147 | } 148 | 149 | method auth { with $!auth { .Str } else { Nil } } 150 | method ver { with $!ver // $!version { $!ver ~~ Version ?? $_ !! $!ver = Version.new($_ // 0) } } 151 | method api { with $!api { $!api ~~ Version ?? $_ !! $!api = Version.new($_ // 0) } } 152 | 153 | # 'new-depends' refers to the hash form of `depends` 154 | has $!new-depends-cache; 155 | method !new-depends($type) { 156 | return Empty unless $.depends ~~ Hash; 157 | $!new-depends-cache := system-collapse($.depends) unless $!new-depends-cache.defined; 158 | return system-collapse($.depends){$type}.grep(*.defined).grep(*.).map(*.).map(*.flat); 159 | } 160 | method !depends2specs(*@depends --> Array[DependencySpecification]) { 161 | my $depends := @depends.map({$_ ~~ List ?? $_.Slip !! $_ }).grep(*.defined); 162 | my DependencySpecification @depends-specs = $depends.map({ Zef::Distribution::DependencySpecification.new($_) }).grep(*.name); 163 | return @depends-specs; 164 | } 165 | 166 | method depends-specs(--> Array[DependencySpecification]) { 167 | my $depends := system-collapse($.depends); 168 | my $deps := $.depends ~~ Hash ?? self!new-depends('runtime') !! $depends; 169 | return self!depends2specs($deps); 170 | } 171 | method build-depends-specs(--> Array[DependencySpecification]) { 172 | my $orig-build-depends := system-collapse($.build-depends); 173 | my $new-build-depends := self!new-depends('build'); 174 | return self!depends2specs(|$orig-build-depends, $new-build-depends); 175 | } 176 | method test-depends-specs(--> Array[DependencySpecification]) { 177 | my $orig-test-depends := system-collapse($.test-depends); 178 | my $new-test-depends := self!new-depends('test'); 179 | return self!depends2specs(|$orig-test-depends, $new-test-depends); 180 | } 181 | 182 | # make locating a module that is part of a distribution (ex. URI::Escape of URI) easier. 183 | # it doesn't need to be a hash mapping as its just for matching 184 | has @!provides-specs; 185 | method provides-specs(--> Array[DependencySpecification]) { 186 | return @!provides-specs if @!provides-specs.elems; 187 | my DependencySpecification @provides-specs = self.meta.grep(*.defined).map({ 188 | # if $spec.name is not defined then .key (the module name of the current provides) 189 | # is not a valid module name (according to Zef::Identity grammar anyway). I ran into 190 | # this problem with `NativeCall::Errno` where one of the provides was: `X:NativeCall::Errorno` 191 | # The single colon cannot just be fixed to DWIM because that could just as easily denote 192 | # an identity part (identity parts are separated by a *single* colon; double colon is left alone) 193 | my $spec = Zef::Distribution::DependencySpecification.new(self!long-name(.key)); 194 | next unless defined($spec.name); 195 | $spec; 196 | }).grep(*.defined).flat; 197 | return @!provides-specs := @provides-specs; 198 | } 199 | 200 | method provides-spec-matcher(DependencySpecification $spec, :$strict --> Bool:D) { 201 | return so self.provides-specs.first({ ?$_.spec-matcher($spec, :$strict) }) 202 | } 203 | 204 | proto method contains-spec(|) {*} 205 | multi method contains-spec(Str $spec, |c --> Bool:D) 206 | { samewith( Zef::Distribution::DependencySpecification.new($spec, |c) ) } 207 | multi method contains-spec(Zef::Distribution::DependencySpecification $spec, Bool :$strict = True --> Bool:D) 208 | { return so self.spec-matcher($spec, :$strict) || self.provides-spec-matcher($spec, :$strict) } 209 | multi method contains-spec(Zef::Distribution::DependencySpecification::Any $spec, Bool :$strict = True --> Bool:D) 210 | { return so self.contains-spec(any($spec.specs), :$strict) } 211 | 212 | method Str(--> Str) { 213 | return self!long-name($!name); 214 | } 215 | 216 | method !long-name($name --> Str) { 217 | return $name 218 | ~ ':ver<' ~ (self.ver // '') 219 | ~ '>:auth<' ~ (self.auth // '').trans(['<', '>'] => ['\<', '\>']) 220 | ~ '>:api<' ~ (self.api // '') 221 | ~ '>' 222 | ; 223 | } 224 | 225 | method id(--> Str) { 226 | use nqp; 227 | return nqp::sha1(self.Str); 228 | } 229 | 230 | method meta(--> Hash:D) { return %!meta } 231 | 232 | method content(|) { 233 | die "this method must be subclassed by something that can read from a content store"; 234 | } 235 | } 236 | -------------------------------------------------------------------------------- /lib/Zef/Repository/LocalCache.rakumod: -------------------------------------------------------------------------------- 1 | use v6.d; 2 | use Zef:ver($?DISTRIBUTION.meta // $?DISTRIBUTION.meta// '*'):api($?DISTRIBUTION.meta // '*'):auth($?DISTRIBUTION.meta // ''); 3 | use Zef::Distribution::DependencySpecification:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 4 | use Zef::Distribution::Local:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 5 | use Zef::Utils::FileSystem:ver(Zef.^ver):api(Zef.^api):auth(Zef.^auth); 6 | 7 | class Zef::Repository::LocalCache does PackageRepository { 8 | 9 | =begin pod 10 | 11 | =title class Zef::Repository::LocalCache 12 | 13 | =subtitle A local caching implementation of the Repository interface 14 | 15 | =head1 Synopsis 16 | 17 | =begin code :lang 18 | 19 | use Zef::Fetch; 20 | use Zef::Repository::LocalCache; 21 | 22 | # Point cache at default zef cache so there are likely some distributions to see 23 | my $cache = $*HOME.child(".zef/store"); 24 | my $repo = Zef::Repository::LocalCache.new(:$cache); 25 | 26 | # Print out all available distributions from this repository 27 | say $_.dist.identity for $repo.available; 28 | 29 | =end code 30 | 31 | =head1 Description 32 | 33 | The C zef uses for its local cache. It is intended to keep track of contents of a directory full 34 | of raku distributions. It provides the optional C method C which allows it to save/copy 35 | any modules downloaded by other repositories. 36 | 37 | Note: distributions installed from local file paths (i.e. C) will not be cached 38 | since local development of modules often occurs without immediately bumping versions (and thus a stale 39 | version would soon get cached). 40 | 41 | Note: THIS IS PROBABLY NOT ANY MORE EFFICIENT THAN ::Ecosystems BASED REPOSITORIES 42 | At one time json parsing/writing was slow enough that parts of this implementation were faster. Now it is mostly 43 | just useful for dynamically generating the MANIFEST.zef from the directory structure this repository expects 44 | instead of fetching a file like C. 45 | 46 | =head1 Methods 47 | 48 | =head2 method search 49 | 50 | method search(Bool :$strict, *@identities ($, *@), *%fields --> Array[Candidate]) 51 | 52 | Resolves each identity in C<@identities> to all of its matching C. If C<$strict> is C then it will 53 | consider partial matches on module short-names (i.e. 'zef search HTTP' will get results for e.g. C). 54 | 55 | =head2 method available 56 | 57 | method available(*@plugins --> Array[Candidate]) 58 | 59 | Returns an C of all C provided by this repository instance (i.e. all distributions in the local cache). 60 | 61 | =head2 method update 62 | 63 | method update(--> Nil) 64 | 65 | Attempts to update the local file / database using the first of C<@.mirrors> that successfully fetches. 66 | 67 | =head2 method store 68 | 69 | method store(*@dists --> Nil) 70 | 71 | Attempts to store/save/cache each C<@dist>. Generally this is called when a module is fetched from e.g. cpan so that this 72 | module can cache it locally for next time. Note distributions fetched from local paths (i.e. `zef install .`) do not generally get passed to this method. 73 | 74 | =end pod 75 | 76 | 77 | #| Int - the db will be lazily updated when it is $!auto-update hours old. 78 | #| Bool True - the db will be lazily updated regardless of how old the db is. 79 | #| Bool False - do not update the db. 80 | has $.auto-update is rw; 81 | 82 | #| Where we will save/stage the db file we fetch 83 | has IO() $.cache; 84 | 85 | #| A array of distributions found in the ecosystem db. Lazily populated as soon as the db is referenced 86 | has Zef::Distribution @!distributions; 87 | 88 | #| Similar to @!distributions, but indexes by short name i.e. { "Foo::Bar" => ($dist1, $dist2), "Baz" => ($dist1) } 89 | has Array[Distribution] %!short-name-lookup; 90 | 91 | #| see role Repository in lib/Zef.rakumod 92 | method available(--> Array[Candidate]) { 93 | self!populate-distributions; 94 | 95 | my Candidate @candidates = @!distributions.map: -> $dist { 96 | Candidate.new( 97 | dist => $dist, 98 | uri => ($dist.source-url || $dist.meta || Str), 99 | from => self.id, 100 | as => $dist.identity, 101 | ); 102 | } 103 | 104 | my Candidate @results = @candidates; 105 | return @results; 106 | } 107 | 108 | #| Rebuild the manifest/index by recursively searching for META files 109 | method update(--> Nil) { 110 | LEAVE { self.store(@!distributions) } 111 | self!update; 112 | self!populate-distributions; 113 | } 114 | 115 | #| Method to allow self.store() call the equivalent of self.update() without infinite recursion 116 | method !update(--> Bool:D) { 117 | # $.cache/level1/level2/ # dirs containing dist files 118 | my @dirs = $!cache.IO.dir.grep(*.d).map(*.dir).flat.grep(*.d); 119 | my @dists = grep { .defined }, map { try Zef::Distribution::Local.new($_) }, @dirs; 120 | my $content = join "\n", @dists.map: { join "\0", (.identity, .path.IO.relative($!cache)) } 121 | so $content ?? self!spurt-package-list($content) !! False; 122 | } 123 | 124 | #| see role Repository in lib/Zef.rakumod 125 | method search(Bool :$strict, *@identities, *%fields --> Array[Candidate]) { 126 | return Nil unless @identities || %fields; 127 | 128 | my %specs = @identities.map: { $_ => Zef::Distribution::DependencySpecification.new($_) } 129 | my @raku-specs = %specs.classify({ .value.from-matcher }).map(*.List).flat; 130 | my @searchable-identities = @raku-specs.grep(*.defined).hash.keys; 131 | return Nil unless @searchable-identities; 132 | 133 | # populate %!short-name-lookup 134 | self!populate-distributions; 135 | 136 | my $grouped-results := @searchable-identities.map: -> $searchable-identity { 137 | my $wanted-spec := %specs{$searchable-identity}; 138 | my $wanted-short-name := $wanted-spec.name; 139 | my $dists-to-search := grep *.so, $strict 140 | ?? %!short-name-lookup{$wanted-short-name}.flat 141 | !! %!short-name-lookup{%!short-name-lookup.keys.grep(*.contains($wanted-short-name, :ignorecase))}.map(*.List).flat;; 142 | 143 | $dists-to-search.grep(*.contains-spec($wanted-spec, :$strict)).map({ 144 | Candidate.new( 145 | dist => $_, 146 | uri => ($_.source-url || $_.meta || Str), 147 | as => $searchable-identity, 148 | from => self.id, 149 | ); 150 | }); 151 | } 152 | 153 | # ((A_Match_1, A_Match_2), (B_Match_1)) -> ( A_Match_1, A_Match_2, B_Match_1) 154 | my Candidate @results = $grouped-results.flat; 155 | 156 | return @results; 157 | } 158 | 159 | #| After the `fetch` phase an app can call `.store` on any Repository that 160 | #| provides it, allowing each Repository to do things like keep a simple list of 161 | #| identities installed, keep a cache of anything installed (how its used here), etc 162 | method store(*@dists --> Bool) { 163 | for @dists.grep({ not self.search($_.identity).elems }) -> $dist { 164 | my $from = $dist.IO; 165 | my $to = $.cache.IO.child($from.basename).child($dist.id); 166 | try copy-paths( $from, $to ) 167 | } 168 | self!update; 169 | } 170 | 171 | #| Location of db file 172 | has IO::Path $!package-list-path; 173 | method !package-list-path(--> IO::Path) { 174 | unless $!package-list-path { 175 | my $dir = $!cache.IO; 176 | $dir.mkdir unless $dir.e; 177 | $!package-list-path = $dir.child('MANIFEST.zef'); 178 | } 179 | return $!package-list-path; 180 | } 181 | 182 | #| Read our package db 183 | method !slurp-package-list(--> List) { 184 | return [ ] unless self!package-list-path.e; 185 | 186 | do given self!package-list-path.open(:r) { 187 | LEAVE {.close} 188 | .lock: :shared; 189 | .slurp.lines.map({.split("\0")[1]}).cache; 190 | } 191 | } 192 | 193 | #| Write our package db 194 | method !spurt-package-list($content --> Bool) { 195 | do given self!package-list-path.open(:w) { 196 | LEAVE {.close} 197 | .lock; 198 | try .spurt($content); 199 | } 200 | } 201 | 202 | #| Populate @!distributions and %!short-name-lookup, essentially initializing the data as late as possible 203 | has $!populate-distributions-lock = Lock.new; 204 | method !populate-distributions(--> Nil) { 205 | $!populate-distributions-lock.protect: { 206 | self!update if $.auto-update || !self!package-list-path.e; 207 | return if +@!distributions; 208 | 209 | for self!slurp-package-list -> $path { 210 | with try Zef::Distribution::Local.new($!cache.add($path)) -> $dist { 211 | # If the distribution doesn't have a name or we can't parse the name then just skip it. 212 | next unless $dist.name; 213 | 214 | # Keep track of out namespaces we are going to index later 215 | my @short-names-to-index; 216 | 217 | # Take the dist identity 218 | push @short-names-to-index, $dist.name; 219 | 220 | # Take the identity of each module in provides 221 | # * The fast path doesn't work with provides entries that are long names (i.e. Foo:ver<1>) 222 | # * The slow path results in parsing the module names in every distributions provides even though 223 | # long names don't work in rakudo (yet) 224 | # * ...So maintain future correctness while getting the fast path in 99% of cases by doing a 225 | # cheap check for '<' and parsing only if needed 226 | append @short-names-to-index, $dist.meta.keys.first(*.contains('<')) 227 | ?? $dist.provides-specs.map(*.name) # slow path 228 | !! $dist.meta.keys; # fast path 229 | 230 | # Index the short name to the distribution. Make sure entries are 231 | # unique since dist name and one module name will usually match. 232 | push %!short-name-lookup{$_}, $dist for @short-names-to-index.grep(*.so).unique; 233 | 234 | push @!distributions, $dist; 235 | } 236 | } 237 | } 238 | } 239 | } 240 | --------------------------------------------------------------------------------