pax_global_header00006660000000000000000000000064135575723010014522gustar00rootroot0000000000000052 comment=f6179433410e8e8260b871ca127aae8942a988b0 zef-0.8.2/000077500000000000000000000000001355757230100123155ustar00rootroot00000000000000zef-0.8.2/.appveyor.yml000066400000000000000000000060141355757230100147640ustar00rootroot00000000000000os: Visual Studio 2015 platform: x64 install: - '"C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x64' - appveyor-retry choco install strawberryperl --allow-empty-checksums - SET PATH=C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\strawberry\perl\bin;%PATH% - appveyor-retry git clone https://github.com/rakudo/rakudo.git %APPVEYOR_BUILD_FOLDER%\..\rakudo - cd %APPVEYOR_BUILD_FOLDER%\..\rakudo - perl Configure.pl --gen-moar --gen-nqp --backends=moar - nmake install - SET PATH=%APPVEYOR_BUILD_FOLDER%\..\rakudo\install\bin;%PATH% - SET PATH=%APPVEYOR_BUILD_FOLDER%\..\rakudo\install\share\perl6\site\bin;%PATH% - cd %APPVEYOR_BUILD_FOLDER% build: off test_script: - perl6 -I. bin/zef --version # run xtests - perl6 -I. xt/repository.t - perl6 -I. xt/install.t # test explicitly via `prove t/*` and `perl6 t/foo.t && perl6 t/bar.t` # both should work, since all our CI envs have prove - perl6 -I. bin/zef --debug --/tap-harness --/prove --perl6-test test . - perl6 -I. bin/zef --debug --/tap-harness --prove --/perl6-test test . # run relative local path test + install - perl6 -I. bin/zef --debug install . # test uninstall - perl6 -I. bin/zef uninstall zef # run absolute local path test + install - perl6 -I. bin/zef install %APPVEYOR_BUILD_FOLDER% # change path to make sure next `zef` commands aren't using any files in cwd or lib/ - cd %APPVEYOR_BUILD_FOLDER%\.. - zef update # test informational commands - zef --version - zef --help - zef locate Zef::CLI - zef locate lib/Zef/CLI.pm6 - zef browse zef bugtracker --/open - zef info zef # test bells and whistles - zef --debug test ./zef - zef --debug search Base64 - zef --debug rdepends Base64 - zef --debug depends Cro::SSL - zef --debug fetch Base64 # test installing from what `fetch` put in ::LocalCache - zef --debug --/cpan --/p6c install Base64 - zef --debug --max=10 list - zef --debug --installed list - zef --debug --force-install install Base64 # test tar + upgrade - zef --debug install https://github.com/ugexe/Perl6-PathTools/archive/0434191c56e0f3254ab1d756d90f9191577de5a0.tar.gz - zef --debug upgrade PathTools # test zip - zef --debug install https://github.com/ugexe/Perl6-Text--Table--Simple/archive/v0.0.3.zip # test remote git repo + tag - zef --debug install https://github.com/ugexe/Perl6-Text--Table--Simple.git@v0.0.4 # Test self contained installation - zef install Distribution::Common --/test - zef install Distribution::Common::Remote -to=inst#foo --contained --/test - zef uninstall Distribution::Common - perl6 -I inst#foo -M Distribution::Common::Remote::Github -e "" - zef --/confirm nuke TempDir StoreDir RootDir - zef update cached # test single repository update; should be 0 after previous nuke - perl6 -I %APPVEYOR_BUILD_FOLDER% %APPVEYOR_BUILD_FOLDER%/bin/zef --/confirm nuke site home shallow_clone: true zef-0.8.2/.circleci/000077500000000000000000000000001355757230100141505ustar00rootroot00000000000000zef-0.8.2/.circleci/config.yml000066400000000000000000000070231355757230100161420ustar00rootroot00000000000000version: 2 variables: macos: &macos macos: xcode: "10.2.0" linux: &linux machine: true install-rakudo: &install-rakudo run: name: Build and install rakudo command: | git clone https://github.com/rakudo/rakudo.git $HOME/rakudo cd $HOME/rakudo perl Configure.pl --gen-moar --gen-nqp --make-install test-zef: &test-zef run: name: Run tests command: | perl6 -I. bin/zef --version # run xtests perl6 -I. xt/repository.t perl6 -I. xt/install.t # test explicitly via `prove t/*` and `perl6 t/foo.t && perl6 t/bar.t` # both should work, since all our CI envs have prove perl6 -I. bin/zef --debug --/tap-harness --/prove --perl6-test test . perl6 -I. bin/zef --debug --/tap-harness --prove --/perl6-test test . # run relative local path test + install perl6 -I. bin/zef --debug install . # test uninstall perl6 -I. bin/zef uninstall zef # run absolute local path test + install perl6 -I. bin/zef install $PWD # change path to make sure next `zef` commands aren't using any files in cwd or lib/ (cd .. && zef update) # test informational commands zef --version zef --help zef locate Zef::CLI zef locate lib/Zef/CLI.pm6 zef browse zef bugtracker --/open zef info zef # test bells and whistles zef --debug test . zef --debug search Base64 zef --debug rdepends Base64 zef --debug depends Cro::SSL zef --debug fetch Base64 # test installing from what `fetch` put in ::LocalCache zef --debug --/cpan --/p6c install Base64 zef --debug --max=10 list zef --debug --installed list zef --debug --force-install install Base64 # test tar + upgrade zef --debug install https://github.com/ugexe/Perl6-PathTools/archive/0434191c56e0f3254ab1d756d90f9191577de5a0.tar.gz zef --debug upgrade PathTools # test zip zef --debug install https://github.com/ugexe/Perl6-Text--Table--Simple/archive/v0.0.3.zip # test remote git repo + tag zef --debug install https://github.com/ugexe/Perl6-Text--Table--Simple.git@v0.0.4 # Test self contained installation zef install Distribution::Common --/test zef install Distribution::Common::Remote -to=inst#foo --contained --/test zef uninstall Distribution::Common perl6 -I inst#foo -M Distribution::Common::Remote::Github -e '' zef --/confirm nuke TempDir StoreDir RootDir zef update cached # test single repository update; should be 0 after previous nuke perl6 -I /home/circleci/project /home/circleci/project/bin/zef --/confirm nuke site home jobs: test-linux: <<: *linux environment: ZEF_PLUGIN_DEBUG: 1 ZEF_BUILDPM_DEBUG: 1 PATH: /home/circleci/rakudo/install/share/perl6/site/bin:/home/circleci/rakudo/install/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin steps: - checkout - *install-rakudo - *test-zef #test-macos: # <<: *macos # environment: # ZEF_PLUGIN_DEBUG: 1 # ZEF_BUILDPM_DEBUG: 1 # PATH: /Users/circleci/rakudo/install/share/perl6/site/bin:/Users/circleci/rakudo/install/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin # steps: # - checkout # - *install-rakudo # - *test-zef workflows: version: 2 test: jobs: - test-linux #- test-macos zef-0.8.2/.github/000077500000000000000000000000001355757230100136555ustar00rootroot00000000000000zef-0.8.2/.github/FUNDING.yml000066400000000000000000000000201355757230100154620ustar00rootroot00000000000000github: [ugexe] zef-0.8.2/.github/ISSUE_TEMPLATE.md000066400000000000000000000011331355757230100163600ustar00rootroot00000000000000 ## Context ## Expected Behavior ## Actual Behavior ## Steps to Reproduce ## Your Environment * perl6 -v * zef list --installed zef-0.8.2/.gitignore000066400000000000000000000000541355757230100143040ustar00rootroot00000000000000*.moarvm *.jar tmp/ lib/.precomp/ .precomp/ zef-0.8.2/.travis.yml000066400000000000000000000060261355757230100144320ustar00rootroot00000000000000language: perl os: - linux - osx env: - BACKEND=moar # - BACKEND=jvm matrix: allow_failures: - env: BACKEND=jvm fast_finish: true sudo: false before_install: - git clone https://github.com/rakudo/rakudo.git $HOME/rakudo - cd $HOME/rakudo - 'if [[ $BACKEND == "moar" ]]; then export OPTS="--gen-moar --gen-nqp --backends=moar"; fi' - 'if [[ $BACKEND == "jvm" ]]; then export OPTS="--gen-nqp --backends=jvm"; fi' - perl Configure.pl $OPTS - make install - export PATH=$HOME/rakudo/install/bin:$PATH - export ZEF_BUILDPM_DEBUG=1 - export PATH=$HOME/rakudo/install/share/perl6/site/bin:$PATH - cd $TRAVIS_BUILD_DIR install: # need at least 1 statement in 'install' - perl6 -v script: - perl6 -I. bin/zef --version # run xtests - perl6 -I. xt/repository.t - perl6 -I. xt/install.t # test explicitly via `prove t/*` and `perl6 t/foo.t && perl6 t/bar.t` # both should work, since all our CI envs have prove - perl6 -I. bin/zef --debug --/tap-harness --/prove --perl6-test test . - perl6 -I. bin/zef --debug --/tap-harness --prove --/perl6-test test . # run relative local path test + install - perl6 -I. bin/zef --debug install . # test uninstall - perl6 -I. bin/zef uninstall zef # run absolute local path test + install - perl6 -I. bin/zef install $TRAVIS_BUILD_DIR # change path to make sure next `zef` commands aren't using any files in cwd or lib/ - cd $TRAVIS_BUILD_DIR/.. - zef update # test informational commands - zef --version - zef --help - zef locate Zef::CLI - zef locate lib/Zef/CLI.pm6 - zef browse zef bugtracker --/open - zef info zef # test bells and whistles - zef --debug test ./zef - zef --debug search Base64 - zef --debug rdepends Base64 - zef --debug depends Cro::SSL - zef --debug fetch Base64 # test installing from what `fetch` put in ::LocalCache - zef --debug --/cpan --/p6c install Base64 - zef --debug --max=10 list - zef --debug --installed list - zef --debug --force-install install Base64 # test tar + upgrade - zef --debug install https://github.com/ugexe/Perl6-PathTools/archive/0434191c56e0f3254ab1d756d90f9191577de5a0.tar.gz - zef --debug upgrade PathTools # test zip - zef --debug install https://github.com/ugexe/Perl6-Text--Table--Simple/archive/v0.0.3.zip # test remote git repo + tag - zef --debug install https://github.com/ugexe/Perl6-Text--Table--Simple.git@v0.0.4 # Test self contained installation - zef install Distribution::Common --/test - zef install Distribution::Common::Remote -to=inst#foo --contained --/test - zef uninstall Distribution::Common - perl6 -I inst#foo -M Distribution::Common::Remote::Github -e '' - zef --/confirm nuke TempDir StoreDir RootDir - zef update cached # test single repository update; should be 0 after previous nuke - perl6 -I $TRAVIS_BUILD_DIR $TRAVIS_BUILD_DIR/bin/zef --/confirm nuke site home zef-0.8.2/LICENSE000066400000000000000000000213061355757230100133240ustar00rootroot00000000000000 The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. zef-0.8.2/META6.json000066400000000000000000000071071355757230100140310ustar00rootroot00000000000000{ "meta-version" : "0", "perl" : "6.c", "name" : "zef", "api" : "0", "version" : "0.8.2", "auth" : "github:ugexe", "description" : "A Raku / Perl 6 module manager", "license" : "Artistic-2.0", "build-depends" : [ ], "test-depends" : [ "Test" ], "depends" : [ "NativeCall" ], "provides" : { "Zef" : "lib/Zef.pm6", "Zef::Build" : "lib/Zef/Build.pm6", "Zef::CLI" : "lib/Zef/CLI.pm6", "Zef::Client" : "lib/Zef/Client.pm6", "Zef::Config" : "lib/Zef/Config.pm6", "Zef::Extract" : "lib/Zef/Extract.pm6", "Zef::Identity" : "lib/Zef/Identity.pm6", "Zef::Install" : "lib/Zef/Install.pm6", "Zef::Test" : "lib/Zef/Test.pm6", "Zef::Fetch" : "lib/Zef/Fetch.pm6", "Zef::Report" : "lib/Zef/Report.pm6", "Zef::Repository" : "lib/Zef/Repository.pm6", "Zef::Repository::LocalCache" : "lib/Zef/Repository/LocalCache.pm6", "Zef::Repository::Ecosystems" : "lib/Zef/Repository/Ecosystems.pm6", "Zef::Distribution" : "lib/Zef/Distribution.pm6", "Zef::Distribution::DependencySpecification" : "lib/Zef/Distribution/DependencySpecification.pm6", "Zef::Distribution::Local" : "lib/Zef/Distribution/Local.pm6", "Zef::Service::InstallPM6" : "lib/Zef/Service/InstallPM6.pm6", "Zef::Service::FetchPath" : "lib/Zef/Service/FetchPath.pm6", "Zef::Service::TAP" : "lib/Zef/Service/TAP.pm6", "Zef::Service::P6CReporter" : "lib/Zef/Service/P6CReporter.pm6", "Zef::Service::Shell::DistributionBuilder" : "lib/Zef/Service/Shell/DistributionBuilder.pm6", "Zef::Service::Shell::LegacyBuild" : "lib/Zef/Service/Shell/LegacyBuild.pm6", "Zef::Service::Shell::Test" : "lib/Zef/Service/Shell/Test.pm6", "Zef::Service::Shell::prove" : "lib/Zef/Service/Shell/prove.pm6", "Zef::Service::Shell::unzip" : "lib/Zef/Service/Shell/unzip.pm6", "Zef::Service::Shell::tar" : "lib/Zef/Service/Shell/tar.pm6", "Zef::Service::Shell::p5tar" : "lib/Zef/Service/Shell/p5tar.pm6", "Zef::Service::Shell::curl" : "lib/Zef/Service/Shell/curl.pm6", "Zef::Service::Shell::git" : "lib/Zef/Service/Shell/git.pm6", "Zef::Service::Shell::wget" : "lib/Zef/Service/Shell/wget.pm6", "Zef::Service::Shell::PowerShell" : "lib/Zef/Service/Shell/PowerShell.pm6", "Zef::Service::Shell::PowerShell::download" : "lib/Zef/Service/Shell/PowerShell/download.pm6", "Zef::Service::Shell::PowerShell::unzip" : "lib/Zef/Service/Shell/PowerShell/unzip.pm6", "Zef::Utils::FileSystem" : "lib/Zef/Utils/FileSystem.pm6", "Zef::Utils::SystemInfo" : "lib/Zef/Utils/SystemInfo.pm6", "Zef::Utils::SystemQuery" : "lib/Zef/Utils/SystemQuery.pm6", "Zef::Utils::URI" : "lib/Zef/Utils/URI.pm6" }, "resources" : [ "config.json", "scripts/perl5tar.pl", "scripts/win32http.ps1", "scripts/win32unzip.ps1" ], "authors" : [ "Nick Logan", "Tony O'Dell" ], "support" : { "bugtracker" : "https://github.com/ugexe/zef/issues", "source" : "https://github.com/ugexe/zef.git" }, "tags" : [ "package-manager", "module-installer", "meta-search", "distribution", "ecosystem", "cpan", "toolchain" ] } zef-0.8.2/README.pod000066400000000000000000000461571355757230100137730ustar00rootroot00000000000000=pod =encoding utf8 =head2 Zef Raku / Perl6 Module Management =for HTML =head1 Installation =head4 Manual $ git clone https://github.com/ugexe/zef.git $ cd zef $ perl6 -I. bin/zef install . =head4 Rakudobrew To install via rakudobrew, please use the following command: $ rakudobrew build zef =head1 USAGE zef --help zef --version # install the CSV::Parser distribution zef install CSV::Parser # search for distribution names matching `CSV` zef search CSV # detailed information for a matching distribution zef info CSV::Parser # list all available distributions zef list # list reverse dependencies of an identity zef rdepends HTTP::UserAgent # test project in current directory zef test . # fetch a specific module only zef fetch CSV::Parser # fetch a module, then shell into its local path zef look CSV::Parser # smoke test modules from all repositories zef smoke # run Build.pm if one exists in given path zef build . # update Repository package lists zef update # upgrade all distributions (BETA) zef upgrade # upgrade specific distribution (BETA) zef upgrade CSV::Parser # lookup module info by name/path/sha1 zef --sha1 locate 9FA0AC28824EE9E5A9C0F99951CA870148AE378E # launch browser to named support urls from meta data zef browse zef bugtracker =head2 More CLI =head4 B [*@identities] Note: The install process does not install anything until all phases have completed. So, if the user requested to C, and A required module B: both would be downloaded, potentially built, tested, and installed -- but only if both passed all their tests. For example: if module A failed its tests, then module B would not be installed (even if it passed its own tests) unless forced. [C<@identities>] can take the form of a file path (starting with B<.> or B), URLs, paths, or identities: # IDENTITY zef install CSV::Parser zef install "CSV::Parser:auth:ver<0.1.2>" zef install "CSV::Parser:ver<0.1.2>" # PATH zef install ./Perl6-Net--HTTP # URL zef -v install git://github.com/ugexe/zef.git zef -v install https://github.com/ugexe/zef/archive/master.tar.gz zef -v install https://github.com/ugexe/zef.git@v0.1.22 A request may contain any number and combination of these. Paths and URLs will be resolved first so they are available to fulfill any dependencies of other requested identities. B # Install to a custom locations --install-to= # site/home/vendor/perl, or -to= # inst#/home/some/path/custom # Install all transitive and direct dependencies # even if they are already installed globally (BETA) --contained # Load a specific Zef config file --config-path=/some/path/config.json # Install only the dependency chains of the requested distributions --deps-only # Ignore errors occuring during the corresponding phase --force-resolve --force-fetch --force-extract --force-build --force-test --force-install # or set the default to all unset --force-* flags to True --force # Set the timeout for corresponding phases --fetch-timeout=600 --extract-timeout=3600 --build-timeout=3600 --test-timeout=3600 --install-timeout=3600 # Number of simultaneous distributions/jobs to process for the corresponding phases --fetch-degree=5 --test-degree=1 # or set the default to all unset --*-timeout flags to 0 --timeout=0 # Do everything except the actual installations --dry # Build/Test/Install each dependency serially before proceeding to Build/Test/Install the next --serial # Disable testing --/test # Disable build phase --/build # Disable fetching dependencies --/depends --/build-depends --/test-depends # Force a refresh for all module index indexes --update # Force a refresh for a specific ecosystem module index --update=[ecosystem] # Skip refreshing all module index indexes --/update # Skip refreshing for a specific ecosystem module index --/update=[ecosystem] B # Number of simultaneous distributions/jobs to process for the corresponding phases (see: --[phase]-degree options) ZEF_FETCH_DEGREE=5 ZEF_TEST_DEGREE=1 # Set the timeout for corresponding phases (see: --[phase]-timeout options) ZEF_FETCH_TIMEOUT=600 ZEF_EXTRACT_TIMEOUT=3600 ZEF_BUILD_TIMEOUT=3600 ZEF_TEST_TIMEOUT=3600 ZEF_INSTALL_TIMEOUT=3600 =head4 B [*@identities] Uninstall the specified distributions Note: Requires a bleeding edge rakudo (not available in 6.c) =head4 B Update the package indexes for all C backends Note: Some C backends, like the default Ecosystems, have an C option in C that can be enabled. This should be the number of hours until it should auto update based on the file system last modified time of the ecosystem json file location. =head4 B [*@identities] I Upgrade specified identities. If no identities are provided, zef attempts to upgrade all installed distributions. =head4 B [$identity] How these are handled depends on the C engine used, which by default is Cp6cE> $ zef -v --cpan --metacpan search URI ===> Found 4 results ------------------------------------------------------------------------- ID|From |Package |Description ------------------------------------------------------------------------- 1 |Zef::Repository::LocalCache |URI:ver<0.1.1> |A URI impleme... 2 |Zef::Repository::Ecosystems |URI:ver<0.1.1> |A URI impleme... 3 |Zef::Repository::Ecosystems |URI:ver<0.1.1> |A URI impleme... 4 |Zef::Repository::Ecosystems |URI:ver<0.000.001>|A URI impleme... ------------------------------------------------------------------------- =head4 B [$identity] View meta information of a distribution $ zef -v info HTTP::UserAgent - Info for: HTTP::UserAgent - Identity: HTTP::UserAgent:ver<1.1.16>:auth - Recommended By: Zef::Repository::LocalCache Author: github:sergot Description: Web user agent Source-url: git://github.com/sergot/http-useragent.git Provides: 11 modules # HTTP::Cookie # HTTP::Header # HTTP::Cookies # HTTP::Message # HTTP::Request # HTTP::Response # HTTP::MediaType # HTTP::UserAgent # HTTP::Header::Field # HTTP::Request::Common # HTTP::UserAgent::Common Depends: 7 items --------------------------------- ID|Identity |Installed? --------------------------------- 1 |HTTP::Status |✓ 2 |File::Temp |✓ 3 |DateTime::Parse |✓ 4 |Encode |✓ 5 |MIME::Base64 |✓ 6 |URI |✓ 7 |IO::Capture::Simple|✓ --------------------------------- B # Extra details (eg, list dependencies and which ones are installed) -v =head4 B [*@from] List known available distributions $ zef --installed list ===> Found via /home/nickl/.rakudobrew/moar-master/install/share/perl6/site CSV::Parser:ver<0.1.2>:auth Zef:auth ===> Found via /home/nickl/.rakudobrew/moar-master/install/share/perl6 CORE:ver<6.c>:auth Note that not every Repository may provide such a list, and such lists may only be a subset. For example: We may not be able to get a list of every distribution on metacpan, but we *can* get the $x most recent additions (we use 100 for now). [C<@from>] allows you to show results from specific repositories only: zef --installed list perl # Only list modules installed by rakudo itself zef list cpan # Only show available modules from the repository zef list p6c # with a name field matching the arguments to `list` zef list cached # (be sure the repository is enabled in config) Otherwise results from all enabled repositories will be returned. B # Only list installed distributions --installed # Additionally list the modules of discovered distributions -v =head4 B [$identity] List direct and transitive dependencies to the first successful build graph for C<$identity> $ zef depends Cro::SSL Cro::Core:ver<0.7> IO::Socket::Async::SSL:ver<0.3> OpenSSL:ver<0.1.14>:auth =head4 B [$identity] List available distributions that directly depend on C<$identity> $ zef rdepends Net::HTTP Minecraft-Tools:ver<0.1.0> LendingClub:ver<0.1.0> =head4 B [*@identities] Fetches candidates for given identities =head4 B [*@paths] Run tests on each distribution located at [C<@paths>] =head4 B [*@paths] Run the Build.pm file located in the given [C<@paths>] If you want to create a build hook, put the following dependency-free boilerplate in a file named C at the root of your distribution: class Build { method build($dist-path) { # do build stuff to your module # which is located at $dist-path } } Set the env variable B or use the I<--debug> flag for additional debugging information. I =head4 B [$identity] Fetches the requested distribution and any dependencies (if requested), changes the directory to that of the fetched distribution, and then stops program execution. This allows you modify or look at the source code before manually continuing the install via C Note that the path to any dependencies that needed to be fetched will be set in env at B, so you should be able to run any build scripts, tests, or complete a manual install without having to specify their locations. =head4 B $identity [bugtracker | homepage | source] B # disables launching a browser window (just shows url) --/open Output the url and launch a browser to open it. # also opens browser $ zef browse Net::HTTP bugtracker https://github.com/ugexe/Perl6-Net--HTTP/issues # only outputs the url $ zef browse Net::HTTP bugtracker --/open https://github.com/ugexe/Perl6-Net--HTTP/issues =head4 B [$identity, $name-path, $sha1-id] B # The argument is a sha1-id (otherwise assumed to be an identity or name-path) --sha1 Lookup a locally installed module by $identity, $name-path, or $sha1-id $ zef --sha1 locate A9948E7371E0EB9AFDF1EEEB07B52A1B75537C31 ===> From Distribution: zef:ver<*>:auth:api<> lib/Zef/CLI.pm6 => ~/rakudo/install/share/perl6/site/sources/A9948E7371E0EB9AFDF1EEEB07B52A1B75537C31 $ zef locate Zef::CLI ===> From Distribution: zef:ver<*>:auth:api<> lib/Zef/CLI.pm6 => ~/rakudo/install/share/perl6/site/sources/A9948E7371E0EB9AFDF1EEEB07B52A1B75537C31 $ zef locate lib/Zef/CLI.pm6 ===> From Distribution: zef:ver<*>:auth:api<> Zef::CLI => ~/rakudo/install/share/perl6/site/sources/A9948E7371E0EB9AFDF1EEEB07B52A1B75537C31 =head4 B [RootDir | TempDir | StoreDir] Deletes all paths in the specific configuration directory =head4 B [site | home] Deletes all paths that are rooted in the prefix of the matching CompUnit::Repository name # uninstall all modules $ zef nuke site home =head2 Output Verbosity You can control the logging level using the following flags: # More/less detailed output --error, --warn, --info (default), --verbose (-v), --debug =head1 Global Configuration =head3 Finding the configuration file You can always see the configuration file that will be used by running: $ zef --help In most cases the default configuration combined with command line options should be enough for most users. If you are most users (e.g. not: power users, packagers, zef plugin developers) you hopefully don't care about this section! =head3 How the configuration file is chosen The configuration file will be chosen at runtime from one of two (technically four) locations, and one can affect the others (this is not really a design decision and suggestions and PRs are welcome). First, and the most precise way, is to specify the config file by passing C<--config-path="..."> to any zef command. Second, third, and fourth we look at the path pointed to by C<%?RESOURCESEconfig.jsonE>. This will point to C<$zef-dir/resources/config.json>, where C<$zef-dir> will be either: =over 4 =item * The prefix of a common configuration directory, such as C<$XDG_CONFIG_HOME> or C<$HOME/.config>. =item * The prefix of a rakudo installation location - This is the case if the modules loaded for bin/zef come from an installation CompUnit::Repository. =item * The current working directory C<$*CWD> - This is the case when modules loaded for bin/zef come from a non-installation CompUnit::Repository (such as C<-I $dist-path>). To understand how this is chosen, consider: # Modules not loaded from an ::Installation, # so %?RESOURCES is $*CWD/resources $ perl6 -I. bin/zef --help ... CONFIGURATION /home/user/perl6/zef/resources/config.json ... # Installed zef script loads modules from an ::Installation, # so %?RESOURCES is $perl6-share-dir/site/resources $ zef --help ... CONFIGURATION /home/user/perl6/install/share/perl6/site/resources/EE5DBAABF07682ECBE72BEE98E6B95E5D08675DE.json ... =back This config is loaded, but it is not yet the chosen config! We check that temporary config's C<%configERootDirE> for valid json in a file named C (i.e. C<%configERootDirE/config.json>). This can be confusing (so it may go away or be refined - PRs welcome) but for most cases it just means C<$*HOME/.zef/config.json> will override an installed zef configuration file. To summarize: =over 4 =item * You can edit the C file before you install zef. When you C that configuration file be be used to install zef and will also be installed with zef such that it will be the default. =item * You can create a C<%configERootDirE/config.json> file. Where C<%configERootDirE> comes from the previously mentioned C<%?RESOURCESEconfig.jsonE>'s C field (C<$*HOME/.zef> in most cases), to allow overriding zef config behavior on a per user basis (allows setting different C<--install-to> targets for, say, a root user and a regular user). Since this new config file could have a different C than the default config (used to find the new one in the first place) this behavior may be changed in the future to be less confusing. =item * You can override both of the previous entries by passing Cany commandE> =back =head3 Configuration fields =head4 Basic Settings =over 4 =item * B - Where zef will look for a custom config.json file =item * B - A staging area for items that have been fetched and need to be extracted/moved =item * B - Where zef caches distributions, package lists, etc after they've been fetched and extracted =item * B - This sets the default value for C<--install-to="...">. The default value of C means it will first try installing to rakudo's installation prefix, and if its not writable by the current user it will install to C<$*HOME/.perl6>. These directories are not chosen by zef - they are actually represented by the magic strings C and C (which, like C, are valid values despite not being paths along with C and C) =back =head4 Phases / Plugins Settings These consist of an array of hashes that describe how to instantiate some class that fulfills the appropriate interface from I (C C C C C) The descriptions follow this format: { "short-name" : "p6c", "enabled" : 1, "module" : "Zef::Repository::Ecosystems", "options" : { } } and are instantiated via ::($hash).new(|($hash) =over 4 =item * B - This adds an enable and disable flag by the same name to the CLI (e.g. C<--p6c> and C<--/p6c>) and is used when referencing which object took some action. =item * B - Set to 0 to skip over the object during consideration (it will never be loaded). If omitted or if the value is non 0 then it will be enabled for use. =item * B - The name of the class to instantiate. While it doesn't technically have to be a module it I need to be a known namespace to C. =item * B - These are passed to the objects C method and may not be consistent between modules as they are free to implement their own requirements. =back See the configuration file in L for a little more information on how plugins are invoked. You can see debug output related to chosing and loading plugins by setting the env variable B =head1 FAQ =head3 CPAN? CPAN is now used as a default (alongside the familiar p6c "ecosystem"). # Explicitly enable cpan (now defaults to the same as `zef search zef`) $ zef --cpan search Inline::Perl5 =head3 Proxy support? All the default fetching plugins have proxy support, but you'll need to refer to the backend program's (wget, curl, git, etc) docs. You may need to set an I variable, or you may need to add a command line option for that specific plugin in I =head3 Custom installation locations? Pass a path to the I<-to> / I<--install-to> option and prefix the path with C (unless you know what you're doing) $ zef -to="inst#/home/perl6/custom" install Text::Table::Simple ===> Searching for: Text::Table::Simple ===> Testing: Text::Table::Simple:ver<0.0.3>:auth ===> Testing [OK] for Text::Table::Simple:ver<0.0.3>:auth ===> Installing: Text::Table::Simple:ver<0.0.3>:auth To make the custom location discoverable: # Set the PERL6LIB env: $ PERL6LIB="inst#/home/perl6/custom" perl6 -e "use Text::Table::Simple; say 'ok'" ok # or simply include it as needed $ perl6 -Iinst#/home/perl6/custom -e "use Text::Table::Simple; say 'ok'" ok =head3 Test reporting? This feature can be enabled by passing `--p6ctesters` (and having C installed) or `--cpantesters` (and having C installed) =cut zef-0.8.2/bin/000077500000000000000000000000001355757230100130655ustar00rootroot00000000000000zef-0.8.2/bin/zef000077500000000000000000000000441355757230100135750ustar00rootroot00000000000000#!/usr/bin/env perl6 use Zef::CLI; zef-0.8.2/lib/000077500000000000000000000000001355757230100130635ustar00rootroot00000000000000zef-0.8.2/lib/Zef.pm6000066400000000000000000000137301355757230100142370ustar00rootroot00000000000000class Zef { } my @zrun-invoke = BEGIN $*DISTRO.is-win ?? ((%*ENV.first({.key.lc eq 'comspec'}).?value // 'cmd.exe').Str, '/x/d/c') !! ''; sub zrun(*@_, *%_) is export { run (|@zrun-invoke, |@_).grep(*.?chars), |%_ } sub zrun-async(*@_, *%_) is export { Proc::Async.new( (|@zrun-invoke, |@_).grep(*.?chars), |%_ ) } # rakudo must be able to parse json, so it doesn't # make sense to require a dependency to parse it sub from-json($text) is export { ::("Rakudo::Internals::JSON").from-json($text) } sub to-json(|c) is export { ::("Rakudo::Internals::JSON").to-json(|c) } # todo: define all the additional options in these signatures, such as passing :$jobs # to `test` (for the prove command), how to handle existing files, etc # A way to avoid printing everything to make --quiet option more univesal between plugins # Need to create a messaging format to include the phase, file, verbosity level, progress, # etc we may or may not display as neccesary. It's current usage is not finalized and # any suggestions for this are well taken role Messenger { has $.stdout = Supplier.new; has $.stderr = Supplier.new; } enum LEVEL is export ; enum STAGE is export ; enum PHASE is export ; # Get a resource located at a uri and save it to the local disk role Fetcher { method fetch($uri, $save-as) { ... } method fetch-matcher($uri) { ... } } # As a post-hook to the default fetchers we will need to extract zip # files. `git` does this itself, so a git based Fetcher wouldn't need this # although we could possibly add `--no-checkout` to `git`s fetch and treat # Extract as the action of `--checkout $branch` (allowing us to "extract" # a specific version from a commit/tag) role Extractor { method extract($archive-file, $target-dir) { ... } method ls-files($archive-file) { ... } method extract-matcher($path) { ... } } # test a single file OR all the files in a directory (recursive optional) role Tester { method test($path, :@includes) { ... } method test-matcher($path) { ... } } role Builder { method build($dist, :@includes) { ... } method build-matcher($path) { ... } } role Installer { method install($dist, :$cur, :$force) { ... } method install-matcher($dist) { ... } } role Reporter { method report($dist) { ... } } role Candidate { has $.dist; has $.as; # Requested as (maybe a url, maybe an identity, maybe a path) has $.from; # Recommended from (::Ecosystems, ::MetaCPAN, ::LocalCache) has $.uri is rw; # url, file path, etc has Bool $.is-dependency is rw; has $.build-results is rw; has $.test-results is rw; } role Repository { # An identifier like .^name but intended to differentiate between instances of the same class # For instance: ::Ecosystems and ::Ecosystems which would otherwise share the # same .^name of ::Ecosystems method id { $?CLASS.^name.split('+', 2)[0] } # max-results is meant so we can :max-results(1) when we are interested in using it like # `.candidates` (i.e. 1 match per identity) so we can stop iterating search plugins earlier method search(:$max-results, *@identities, *%fields --> Iterable) { ... } # Optional method currently being called after a search/fetch # to assist ::Repository::LocalCache in updating its MANIFEST path cache. # The concept needs more thought, but for instance a GitHub related repositories # could commit changes or push to a remote branch, and (as is now) the cs # ::LocalCache to update MANIFEST so we don't *have* to do a recursive folder search # # method store(*@dists) { } # Optional method for listing available packages. For p6c style repositories # where we have an index file this is easy. For metacpan style where we # make a remote query not so much (maybe it could list the most recent X # modules... or maybe it just doesn't implement it at all) # method available { } } # Used by the phase's loader (i.e Zef::Fetch) to test that the plugin can # be used. for instance, ::Shell wrappers probe via `cmd --help`. Note # that the result of .probe is cached by each phase loader role Probeable { method probe returns Bool { ... } } role Pluggable { has $!plugins; has @.backends; sub DEBUG($plugin, $message) { say "[Plugin - {$plugin // $plugin // qq||}] $message"\ if ?%*ENV; } method plugins(*@names) { +@names ?? self!list-plugins.grep({@names.contains(.short-name)}) !! self!list-plugins; } method !list-plugins { gather for @!backends -> $plugin { my $module = $plugin; DEBUG($plugin, "Checking: {$module}"); # default to enabled unless `"enabled" : 0` next() R, DEBUG($plugin, "\t(SKIP) Not enabled")\ if $plugin:exists && (!$plugin || $plugin eq "0"); next() R, DEBUG($plugin, "\t(SKIP) Plugin could not be loaded")\ if (try require ::($ = $module)) ~~ Nil; DEBUG($plugin, "\t(OK) Plugin loaded successful"); if ::($ = $module).^find_method('probe') { ::($ = $module).probe ?? DEBUG($plugin, "\t(OK) Probing successful") !! (next() R, DEBUG($plugin, "\t(SKIP) Probing failed")) } # add attribute `short-name` here to make filtering by name slightly easier # until a more elegant solution can be integrated into plugins themselves my $class = ::($ = $module).new(|($plugin // []))\ but role :: { has $.short-name = $plugin // '' }; next() R, DEBUG($plugin, "(SKIP) Plugin unusable: initialization failure")\ unless ?$class; DEBUG($plugin, "(OK) Plugin is now usable: {$module}"); take $class; } } } zef-0.8.2/lib/Zef/000077500000000000000000000000001355757230100136075ustar00rootroot00000000000000zef-0.8.2/lib/Zef/Build.pm6000066400000000000000000000027241355757230100152770ustar00rootroot00000000000000use Zef; class Zef::Build does Pluggable { submethod TWEAK(|) { @ = self.plugins; # preload plugins } method build-matcher($dist) { self.plugins.grep(*.build-matcher($dist)) } method build($candi, :@includes, Supplier :$logger, Int :$timeout, :$meta) { my $dist := $candi.dist; die "Can't build non-existent path: {$dist.path}" unless $dist.path.IO.e; my $builder = self.build-matcher($dist).first(*.so); die "No building backend available" unless ?$builder; if ?$logger { $logger.emit({ level => DEBUG, stage => BUILD, phase => START, candi => $candi, message => "Building with plugin: {$builder.^name}" }); $builder.stdout.Supply.grep(*.defined).act: -> $out { $logger.emit({ level => VERBOSE, stage => BUILD, phase => LIVE, candi => $candi, message => $out }) } $builder.stderr.Supply.grep(*.defined).act: -> $err { $logger.emit({ level => ERROR, stage => BUILD, phase => LIVE, candi => $candi, message => $err }) } } my $todo = start { try $builder.build($dist, :@includes) }; my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new); await Promise.anyof: $todo, $time-up; $logger.emit({ level => DEBUG, stage => BUILD, phase => LIVE, candi => $candi, message => "Building {$dist.path} timed out" }) if ?$logger && $time-up.so && $todo.not; my @got = $todo.so ?? $todo.result !! False; @got; } } zef-0.8.2/lib/Zef/CLI.pm6000066400000000000000000001320021355757230100146400ustar00rootroot00000000000000use Zef; use Zef::Client; use Zef::Config; use Zef::Utils::FileSystem; use Zef::Identity; use Zef::Distribution; use Zef::Utils::SystemInfo; use nqp; # Content was cut+pasted from bin/zef, leaving bin/zef's contents as just: `use Zef::CLI;` # This allows the bin/zef original code to be precompiled, halving bare start up time. # Ideally this all ends up back in bin/zef once/if precompilation of scripts is handled in CURI package Zef::CLI { my $verbosity = preprocess-args-verbosity-mutate(@*ARGS); %*ENV = $verbosity >= DEBUG; my $CONFIG = preprocess-args-config-mutate(@*ARGS); my $VERSION = try EVAL q[$?DISTRIBUTION.meta.first(*.so)]; # TODO: deprecate usage of --depsonly @*ARGS = @*ARGS.map: { $_ eq '--depsonly' ?? '--deps-only' !! $_ } proto MAIN(|) is export { # Supress backtrace CATCH { default { try { ::("Rakudo::Internals").?LL-EXCEPTION } ?? .rethrow !! .message.¬e; &*EXIT(1) } } {*} } #| Download specific distributions multi MAIN( 'fetch', Bool :force(:$force-fetch), Int :timeout(:$fetch-timeout) = %*ENV // 600, Int :degree(:$fetch-degree) = %*ENV || 5, # default different from Zef::Client, :$update, *@identities ($, *@) ) { my $client = get-client(:config($CONFIG), :$force-fetch, :$update, :$fetch-timeout, :$fetch-degree); my @candidates = $client.find-candidates(@identities.map(*.&str2identity)); abort "Failed to resolve any candidates. No reason to proceed" unless +@candidates; my @fetched = $client.fetch(@candidates); my @fail = @candidates.grep: {.as !~~ any(@fetched>>.as)} say "!!!> Fetch failed: {.as}{?($verbosity >= VERBOSE)??' at '~.dist.path!!''}" for @fail; exit +@fetched && +@fetched == +@candidates && +@fail == 0 ?? 0 !! 1; } #| Run tests multi MAIN( 'test', Bool :force(:$force-test), Int :timeout(:$test-timeout) = %*ENV || 3600, # Int :degree(:$test-degree) = %*ENV || 1, # degree affects simutanious distributions being tests, but this tests a single distribution *@paths ($, *@) ) { my $client = get-client(:config($CONFIG), :$force-test, :$test-timeout); my @candidates = $client.link-candidates( @paths.map(*.&path2candidate) ); abort "Failed to resolve any candidates. No reason to proceed" unless +@candidates; my @tested = $client.test(@candidates); my (:@test-pass, :@test-fail) := @tested.classify: {.test-results.grep(*.so) ?? !! } say "!!!> Testing failed: {.as}{?($verbosity >= VERBOSE)??' at '~.dist.path!!''}" for @test-fail; exit ?@test-fail ?? 1 !! ?@test-pass ?? 0 !! 255; } #| Run Build.pm multi MAIN( 'build', Bool :force(:$force-build), Int :timeout(:$build-timeout) = %*ENV || 3600, *@paths ($, *@) ) { my $client = get-client(:config($CONFIG), :$force-build, |(:$build-timeout with $build-timeout),); my @candidates = $client.link-candidates( @paths.map(*.&path2candidate) ); abort "Failed to resolve any candidates. No reason to proceed" unless +@candidates; my @built = $client.build(@candidates); my (:@pass, :@fail) := @built.classify: {.?build-results.grep(*.so).elems ?? !! } say "!!!> Build failure: {.as}{?($verbosity >= VERBOSE)??' at '~.dist.path!!''}" for @fail; exit ?@fail ?? 1 !! ?@pass ?? 0 !! 255; } #| Install multi MAIN( 'install', Bool :$fetch = True, Bool :$build = True, Bool :$test = True, Bool :$depends = True, Bool :$test-depends = $test, Bool :$build-depends = $build, Bool :$force, Bool :$force-resolve = $force, Bool :$force-fetch = $force, Bool :$force-extract = $force, Bool :$force-build = $force, Bool :$force-test = $force, Bool :$force-install = $force, Int :$timeout, Int :$fetch-timeout = %*ENV // $timeout // 600, Int :$extract-timeout = %*ENV // $timeout // 3600, Int :$build-timeout = %*ENV // $timeout // 3600, Int :$test-timeout = %*ENV // $timeout // 3600, Int :$install-timeout = %*ENV // $timeout // 3600, Int :$degree, Int :$fetch-degree = %*ENV || $degree || 5, # default different from Zef::Client Int :$test-degree = %*ENV || $degree || 1, Bool :$dry, Bool :$upgrade, Bool :$deps-only, Bool :$serial, Bool :$contained, :$update, :$exclude, :to(:$install-to) = $CONFIG, *@wants ($, *@) ) { @wants .= map: *.&str2identity; my (:@paths, :@uris, :@identities) := @wants.classify: -> $wanted { $wanted ~~ /^[\. | \/]/ ?? !! ?Zef::Identity.new($wanted) ?? !! (my $uri = Zef::Utils::URI($wanted) and !$uri.is-relative) ?? !! abort("Don't understand identity: {$wanted}"); } my $client = get-client( :config($CONFIG), :$update, :exclude($exclude.map({ Zef::Distribution::DependencySpecification.new($_) })), :$depends, :$test-depends, :$build-depends, :$force-resolve, :$force-fetch, :$force-extract, :$force-build, :$force-test, :$force-install, :$fetch-timeout, :$extract-timeout, :$build-timeout, :$test-timeout, :$install-timeout, :$fetch-degree, :$test-degree, ); # LOCAL PATHS abort "The following were recognized as file paths but don't exist as such - {@paths.grep(!*.IO.e)}" if +@paths.grep(!*.IO.e); my (:@wanted-paths, :@skip-paths) := @paths\ .classify: {$client.is-installed(Zef::Distribution::Local.new($_).identity, :at($install-to.map(*.&str2cur))) ?? !! } say "The following local path candidates are already installed: {@skip-paths.join(', ')}"\ if ($verbosity >= VERBOSE) && +@skip-paths; my @requested-paths = ?$force-install ?? @paths !! @wanted-paths; my @path-candidates = @requested-paths.map(*.&path2candidate); # URIS my @uri-candidates-to-check = $client.fetch( @uris.map({ Candidate.new(:as($_), :uri($_)) }) ) if +@uris; abort "No candidates found matching uri: {@uri-candidates-to-check.join(', ')}" if +@uris && +@uri-candidates-to-check == 0; my (:@wanted-uris, :@skip-uris) := @uri-candidates-to-check\ .classify: {$client.is-installed($_.dist.identity, :at($install-to.map(*.&str2cur))) ?? !! } say "The following uri candidates are already installed: {@skip-uris.map(*.as).join(', ')}"\ if ($verbosity >= VERBOSE) && +@skip-uris; my @requested-uris = (?$force-install ?? @uri-candidates-to-check !! @wanted-uris)\ .grep: { $_ ~~ none(@path-candidates.map(*.dist.identity)) } my @uri-candidates = @requested-uris; # IDENTITIES my (:@wanted-identities, :@skip-identities) := @identities\ .classify: {$client.is-installed($_, :at($install-to.map(*.&str2cur))) ?? !! } say "The following candidates are already installed: {@skip-identities.join(', ')}"\ if ($verbosity >= VERBOSE) && +@skip-identities; my @requested-identities = (?$force-install ?? @identities !! @wanted-identities)\ .grep: { $_ ~~ none(@uri-candidates.map(*.dist.identity)) } my @requested = $client.find-candidates(:$upgrade, @requested-identities) if +@requested-identities; abort "No candidates found matching identity: {@requested-identities.join(', ')}"\ if +@requested-identities && +@requested == 0; my @prereqs = $client.find-prereq-candidates(:skip-installed(not $contained), |@path-candidates, |@uri-candidates, |@requested)\ if +@path-candidates || +@uri-candidates || +@requested; my @candidates = grep *.defined, ?$deps-only ?? @prereqs !! (|@path-candidates, |@uri-candidates, |@requested, |@prereqs); unless +@candidates { note("All candidates are currently installed"); exit(0) if $deps-only; abort("No reason to proceed. Use --force-install to continue anyway", 0) unless $force-install; } my (:@local, :@remote) := @candidates.classify: {.dist ~~ Zef::Distribution::Local ?? !! } my @fetched = grep *.so, |@local, ($client.fetch(@remote).Slip if +@remote && $fetch); my CompUnit::Repository @to = $install-to.map(*.&str2cur); my @installed = $client.make-install( :@to, :$fetch, :$test, :$build, :$upgrade, :$update, :$dry, :$serial, @fetched ); my @fail = @candidates.grep: {.as !~~ any(@installed>>.as)} say "!!!> Install failures: {@fail.map(*.dist.identity).join(', ')}" if +@fail; exit +@installed && +@installed == +@candidates && +@fail == 0 ?? 0 !! 1; } #| Uninstall multi MAIN( 'uninstall', :from(:$uninstall-from) = $CONFIG, *@identities ($, *@) ) { my $client = get-client(:config($CONFIG)); my CompUnit::Repository @from = $uninstall-from.map(*.&str2cur); my @uninstalled = $client.uninstall( :@from, @identities.map(*.&str2identity) ); my @fail = @identities.grep(* !~~ any(@uninstalled.map(*.as))); if +@uninstalled == 0 && +@fail { note("!!!> Found no matching candidates to uninstall"); exit 1; } for @uninstalled.classify(*.from).kv -> $from, $candidates { say "===> Uninstalled from $from"; say "$_" for |$candidates>>.dist>>.identity; } say "!!!> Failed to uninstall distributions: {@fail.join('. ')}" if +@fail; exit +@fail ?? 1 !! 0; } #| Get a list of possible distribution candidates for the given terms multi MAIN('search', Int :$wrap = False, :$update, *@terms ($, *@)) { my $client = get-client(:config($CONFIG), :$update); my @results = $client.search(@terms); say "===> Found " ~ +@results ~ " results"; my @rows = eager gather for @results -> $candi { FIRST { take [] } take [ $++, $candi.from, $candi.dist.identity, ($candi.dist.hash // '') ]; } print-table(@rows, :$wrap); exit 0; } #| A list of available modules from enabled repositories multi MAIN('list', Int :$max?, :$update, Bool :i(:$installed), *@at) { my $client = get-client(:config($CONFIG), :$update); my $found := ?$installed ?? $client.list-installed(@at.map(*.&str2cur)) !! $client.list-available(@at); my $range := defined($max) ?? 0..+$max !! *; my %locations = $found[$range].classify: -> $candi { $candi.from } for %locations.kv -> $from, $candis { note "===> Found via {$from}"; for $candis.sort(*.dist.identity) -> $candi { say "{$candi.dist.identity}"; say "#\t{$_}" for @($candi.dist.provides.keys.sort if ?($verbosity >= VERBOSE)); } } exit 0; } #| Upgrade installed distributions (BETA) multi MAIN( 'upgrade', Bool :$fetch = True, Bool :$build = True, Bool :$test = True, Bool :$depends = True, Bool :$test-depends = $test, Bool :$build-depends = $build, Bool :$force, Bool :$force-resolve = $force, Bool :$force-fetch = $force, Bool :$force-extract = $force, Bool :$force-build = $force, Bool :$force-test = $force, Bool :$force-install = $force, Int :$timeout, Int :$fetch-timeout = %*ENV // $timeout // 600, Int :$extract-timeout = %*ENV // $timeout // 3600, Int :$build-timeout = %*ENV // $timeout // 3600, Int :$test-timeout = %*ENV // $timeout // 3600, Int :$install-timeout = %*ENV // $timeout // 3600, Int :$degree, Int :$fetch-degree = %*ENV || $degree || 5, # default different from Zef::Client, Int :$test-degree = %*ENV || $degree || 1, Bool :$dry, Bool :$update, Bool :$serial, :$exclude, :to(:$install-to) = $CONFIG, *@identities ) { # XXX: This is a very inefficient prototype. Not sure how to handle an 'upgrade' when # multiple versions are already installed, so for now an 'upgrade' always means we # leave the previous version installed. my $client = get-client( :config($CONFIG), :exclude($exclude.map({ Zef::Distribution::DependencySpecification.new($_) })), :$depends, :$test-depends, :$build-depends, :$force-resolve, :$force-fetch, :$force-extract, :$force-build, :$force-test, :$force-install, :$fetch-timeout, :$extract-timeout, :$build-timeout, :$test-timeout, :$install-timeout, :$fetch-degree, :$test-degree ); my @missing = @identities.grep: { not $client.is-installed($_) }; abort "Can't upgrade identities that aren't installed: {@missing.join(', ')}" if +@missing; my @installed = $client.list-installed($install-to.map(*.&str2cur))\ .sort(*.dist.ver).sort(*.dist.api).reverse\ .unique(:as({"{.dist.name}:auth<{.dist.auth-matcher}>"})); my @requested = +@identities ?? $client.find-candidates(@identities.map(*.&str2identity)) !! $client.find-candidates(@installed.map(*.dist.clone(ver => "*")).map(*.identity).unique); my (:@upgradable, :@current, :@unknown) := @requested.classify: -> $candi { my $latest-installed = @installed.grep({ .dist.name eq $candi.dist.name })\ .sort({ .dist.auth-matcher ne $candi.dist.auth-matcher }).head; # this is to handle auths that changed. need to find a better way... !$latest-installed ?? !! (($latest-installed.dist.ver <=> $candi.dist.ver) === Order::Less) ?? !! ; } note "Unsure of how to handle the following distributions: {@unknown.map(*.dist.identity),join(',')}" if +@unknown; abort("All requested distributions are already at their latest versions", 0) unless +@upgradable; say "The following distributions will be upgraded: {@upgradable.map(*.dist.identity).join(', ')}"; my &installer = &MAIN.assuming( :$depends, :$test-depends, :$build-depends, :$test, :$fetch, :$build, :$update, :$exclude, :$install-to, :$force-resolve, :$force-fetch, :$force-build, :$force-test, :$force-install, :$fetch-timeout, :$extract-timeout, :$build-timeout, :$test-timeout, :$fetch-degree, :$test-degree, :$dry, :$serial, ); # Sort these ahead of time so they can be installed individually by passing # the .uri instead of the identities (which would require another search) my @sorted-candidates = $client.sort-candidates(@upgradable); say "===> Updating: " ~ @sorted-candidates.map(*.dist.identity).join(', '); my (:@upgraded, :@failed) := @sorted-candidates.map(*.uri).classify: -> $uri { my &*EXIT = sub ($code) { return $code == 0 ?? True !! False }; try { &installer('install', $uri) } ?? !! ; } abort "!!!> Failed upgrading *all* modules" unless +@upgraded; say "!!!> Some modules failed to update: {@failed.map(*.dist.identity).join(', ')}" if +@failed; exit +@upgraded < +@upgradable ?? 1 !! 0; } #| View dependencies of a distribution multi MAIN( 'depends', $identity, Bool :$depends = True, Bool :$test-depends = True, Bool :$build-depends = True, ) { # TODO: refactor this stuff which was copied from 'install' # So really we just need a function to handle separating the different identity types # and optionally delivering a message for each section. my @wants = ($identity,).map: *.&str2identity; my (:@paths, :@uris, :@identities) := @wants.classify: -> $wanted { $wanted ~~ /^[\. | \/]/ ?? !! ?Zef::Identity.new($wanted) ?? !! (my $uri = Zef::Utils::URI($wanted) and !$uri.is-relative) ?? !! abort("Don't understand identity: {$wanted}"); } my $client = Zef::Client.new(:config($CONFIG), :$depends, :$test-depends, :$build-depends,); abort "The following were recognized as file paths but don't exist as such - {@paths.grep(!*.IO.e)}" if +@paths.grep(!*.IO.e); my @path-candidates = @paths.map(*.&path2candidate); my @uri-candidates-to-check = $client.fetch( @uris.map({ Candidate.new(:as($_), :uri($_)) }) ) if +@uris; abort "No candidates found matching uri: {@uri-candidates-to-check.join(', ')}" if +@uris && +@uri-candidates-to-check == 0; my @uri-candidates = @uri-candidates-to-check.grep: { $_ ~~ none(@path-candidates.map(*.dist.identity)) } my @requested-identities = @identities.grep: { $_ ~~ none(@uri-candidates.map(*.dist.identity)) } my @requested = $client.find-candidates(@requested-identities) if +@requested-identities; abort "No candidates found matching identity: {@requested-identities.join(', ')}"\ if +@requested-identities && +@requested == 0; my @prereqs = $client.find-prereq-candidates(:!skip-installed, |@path-candidates, |@uri-candidates, |@requested)\ if +@path-candidates || +@uri-candidates || +@requested; .say for @prereqs.map(*.dist.identity); } #| View direct reverse dependencies of a distribution multi MAIN( 'rdepends', $identity, Bool :$depends = True, Bool :$test-depends = True, Bool :$build-depends = True, ) { my $client = get-client(:config($CONFIG), :$depends, :$test-depends, :$build-depends); .dist.identity.say for $client.list-rev-depends($identity); exit 0; } #| Lookup locally installed distributions by short-name, name-path, or sha1 id multi MAIN('locate', $identity, Bool :$sha1) { my $client = get-client(:config($CONFIG)); if !$sha1 { if $identity.ends-with('.pm' | '.pm6' | '.rakumod') { my @candis = $client.list-installed.grep({ .dist.compat.meta.values.grep({parse-value($_) eq $identity}).so; }); for @candis -> $candi { LAST exit 0; NEXT say ''; if $candi { # This is relying on implementation details for compatability purposes. It will # use something more appropriate sometime in 2019. my %meta = $candi.dist.compat.meta; %meta = %meta.map({ $_.key => parse-value($_.value) }).hash; my $lib = %meta.hash.antipairs.hash.{$identity}; my $lib-sha1 = nqp::sha1($lib ~ CompUnit::Repository::Distribution.new($candi.dist.compat).id); say "===> From Distribution: {~$candi.dist}"; say "{$lib} => {$candi.from.prefix.child('sources').child($lib-sha1)}"; } } } elsif $identity.starts-with('bin/' | 'resources/') { my @candis = $client.list-installed.grep({ .dist.compat.meta.first({.key eq $identity}).so }); for @candis -> $candi { LAST exit 0; NEXT say ''; if $candi { my $libs = $candi.dist.compat.meta; my $lib = $libs.first({.key eq $identity}); say "===> From Distribution: {~$candi.dist}"; say "{$identity} => {$candi.from.prefix.child('resources').child($lib.value)}"; } } } elsif $client.resolve($identity) -> @candis { for @candis -> $candi { LAST exit 0; NEXT say ''; say "===> From Distribution: {~$candi.dist}"; my $source-prefix = $candi.from.prefix.child('sources'); my $source-path = $source-prefix.child(nqp::sha1($identity ~ CompUnit::Repository::Distribution.new($candi.dist.compat).id)); say "{$identity} => {$source-path}" if $source-path.IO.f; } } } else { my @candis = $client.list-installed.grep(-> $candi { # This is relying on implementation details for compatability purposes. It will # use something more appropriate sometime in 2019. use nqp; my %meta = $candi.dist.compat.meta; %meta = %meta.map({ $_.key => parse-value($_.value) }).hash; my @source_files = %meta.map({ nqp::sha1($_.key ~ CompUnit::Repository::Distribution.new($candi.dist.compat).id) }); my @resource_files = %meta.values.first({$_ eq $identity}); $identity ~~ any(grep *.defined, flat @source_files, @resource_files); }); for @candis -> $candi { LAST exit 0; NEXT say ''; if $candi { my %meta = $candi.dist.compat.meta; %meta = %meta.map({ $_.key => parse-value($_.value) }).hash; my %sources = %meta.map({ $_.key => nqp::sha1($_.key ~ CompUnit::Repository::Distribution.new($candi.dist.compat).id) }).hash; say "===> From Distribution: {~$candi.dist}"; $identity ~~ any(%sources.values) ?? (say "{$_} => {$candi.from.prefix.child('sources').child($identity)}" for %sources.antipairs.hash{$identity}) !! (say "{.key} => {.value}" for $candi.dist.compat.meta.first({.value eq $identity})); } } } say "!!!> Nothing located"; exit 1; } #| Detailed distribution information multi MAIN('info', $identity, :$update, Int :$wrap = False) { my $client = get-client(:config($CONFIG), :$update); my $latest-installed-candi = $client.resolve($identity).head; my @remote-candis = $client.search($identity, :strict, :max-results(1)); abort "!!!> Found no candidates matching identity: {$identity}" unless $latest-installed-candi || +@remote-candis; my $candi := ($latest-installed-candi, |@remote-candis).grep(*.defined).sort(*.dist.ver).sort(*.dist.api).tail; my $dist := $candi.dist; say "- Info for: $identity"; say "- Identity: {$dist.identity}"; say "- Recommended By: {$candi.from}"; say "- Installed: {$latest-installed-candi??$latest-installed-candi.dist.identity eq $dist.identity??qq|Yes|!!qq|Yes, as $latest-installed-candi.dist.identity()|!!'No'}"; say "Author:\t {$dist.author}" if $dist.author; say "Description:\t {$dist.description}" if $dist.description; say "License:\t {$dist.compat.meta}" if $dist.compat.meta; say "Source-url:\t {$dist.source-url}" if $dist.source-url; my @provides = $dist.provides.sort(*.key.chars); say "Provides: {@provides.elems} modules"; if ?($verbosity >= VERBOSE) { my $meta := $dist.compat.meta; my @rows = eager gather for @provides -> $lib { FIRST { take [] } my $module-name = $lib.key; my $name-path = parse-value($lib.value); take [ $module-name, $name-path ]; } print-table(@rows, :$wrap); } if $dist.hash { say "Support:"; for $dist.hash.kv -> $k, $v { say "# $k:\t$v"; } } my @deps = (|$dist.depends-specs, |$dist.test-depends-specs, |$dist.build-depends-specs).grep(*.defined).unique; say "Depends: {@deps.elems} items"; if ?($verbosity >= VERBOSE) { my @rows = eager gather for @deps -> $spec { FIRST { take [] } my $row = [ "{state $id += 1}", $spec.name, ($client.is-installed($spec) ?? '✓' !! '')]; take $row; } print-table(@rows, :$wrap); } exit 0; } #| Browse a distribution's available support urls (homepage, bugtracker, source) multi MAIN('browse', $identity, $url-type where * ~~ any(), Bool :$open = True) { my $client = get-client(:config($CONFIG)); my $candi = $client.resolve($identity).head || $client.search($identity, :strict, :max-results(1))[0]\ || abort "!!!> Found no candidates matching identity: {$identity}"; my %support = $candi.dist.compat.meta; my $url = %support{$url-type}; my @has-urls = grep { %support{$_} }, ; unless $url && $url.starts-with('http://' | 'https://') { say "'browse' urls supported by $identity: {+@has-urls??@has-urls.join(',')!!'none'}"; exit 255; } say $url; my @cmd = $*DISTRO.is-win ?? !! $*VM.osname eq 'darwin' ?? !! ; run( |@cmd, $url ) if $open; } #| Download a single module and change into its directory multi MAIN('look', $identity) { my $client = get-client(:config($CONFIG)); my @candidates = $client.find-candidates( str2identity($identity) ); abort "Failed to resolve any candidates. No reason to proceed" unless +@candidates; my (:@remote, :@local) := @candidates.classify: {.dist !~~ Zef::Distribution::Local ?? !! } my $fetched = @local[0] || $client.fetch(@remote[0])[0] || abort "Failed to fetch candidate: $identity"; my $dist-path = $fetched.dist.path; say "===> Shelling into directory: {$dist-path}"; exit so shell(%*ENV // %*ENV // %*ENV, :cwd($dist-path)) ?? 0 !! 1; } #| Smoke test multi MAIN( 'smoke', Bool :$fetch = True, Bool :$build = True, Bool :$test = True, Bool :$depends = True, Bool :$test-depends = $test, Bool :$build-depends = $build, Bool :$force, Bool :$force-resolve = $force, Bool :$force-fetch = $force, Bool :$force-extract = $force, Bool :$force-build = $force, Bool :$force-test = $force, Bool :$force-install = $force, Int :$timeout, Int :$fetch-timeout = %*ENV // $timeout // 600, Int :$extract-timeout = %*ENV // $timeout // 3600, Int :$build-timeout = %*ENV // $timeout // 3600, Int :$test-timeout = %*ENV // $timeout // 3600, Int :$install-timeout = %*ENV // $timeout // 3600, Int :$degree, Int :$fetch-degree = %*ENV || $degree || 5, # default different from Zef::Client, Int :$test-degree = %*ENV || $degree || 1, Bool :$update, Bool :$upgrade, Bool :$dry, Bool :$serial, :$exclude, :to(:$install-to) = $CONFIG, ) { my $client = get-client( :config($CONFIG), :exclude($exclude.map({ Zef::Distribution::DependencySpecification.new($_) })), :$depends, :$test-depends, :$build-depends, :$force-resolve, :$force-fetch, :$force-extract, :$force-build, :$force-test, :$force-install, :$fetch-timeout, :$extract-timeout, :$build-timeout, :$test-timeout, :$install-timeout, :$fetch-degree, :$test-degree, ); my @identities = $client.list-available.map(*.dist.identity).unique; my CompUnit::Repository @to = $install-to.map(*.&str2cur); say "===> Smoke testing with {+@identities} distributions..."; my &installer = &MAIN.assuming( 'install', :$depends, :$test-depends, :$build-depends, :$test, :$fetch, :$build, :$update, :$upgrade, :$exclude, :$install-to, :$force-resolve, :$force-fetch, :$force-build, :$force-test, :$force-install, :$fetch-timeout, :$extract-timeout, :$build-timeout, :$test-timeout, :$fetch-degree, :$test-degree, :$dry, :$serial, ); for @identities -> $identity { my &*EXIT = sub ($code) { return $code == 0 ?? True !! False }; my $result = try installer($identity); say "===> Smoke result for {$identity}: {?$result??'OK'!!'NOT OK'}"; } exit 0; } #| Update package indexes multi MAIN('update', *@names) { my $client = get-client(:config($CONFIG)); my %results = $client.recommendation-manager.update(@names); my $rows = %results.map: {[.key, .value]}; abort "A plugin name was provided that does not exist or does not support 'update'" if +@names && (+@names > +$rows); print-table( [["Content Storage", "Distribution Count"], |$rows], wrap => True ); exit 0; } #| Nuke module installations (site, home) and repositories from config (RootDir, StoreDir, TempDir) multi MAIN('nuke', Bool :$confirm, *@names ($, *@)) { my sub dir-delete($dir) { my @deleted = grep *.defined, try delete-paths($dir, :f, :d, :r); say "Deleted " ~ +@deleted ~ " paths from $dir/*"; } my sub confirm-delete(*@dirs) { for @dirs -> $dir { next() R, say "$dir does not exist. Skipping..." unless $dir.IO.e; given prompt("Delete {$dir.path}/* [y/n]: ") { when any() { dir-delete($dir) } when any() { say "Skipping..." } default { say "Invalid entry (enter Y or N)"; redo } } } } my @config-keys = ; my @config-dirs = $CONFIG<<{@names (&) @config-keys}>>.map(*.IO.absolute).sort; my @curli-dirs = @names\ .grep(* !~~ any(@config-keys))\ .map(*.&str2cur)\ .grep(*.?can-install)\ .map(*.prefix.absolute); my @delete = |@curli-dirs, |@config-dirs; $confirm === False ?? @delete.map(*.&dir-delete) !! confirm-delete( @delete ); exit 0; } #| Detailed version information multi MAIN(Bool :$version where .so) { say $*PERL.compiler.version <= v2018.12 ?? 'Version detection requires a rakudo newer than v2018.12' !! ($VERSION // 'unknown'); exit 0; } multi MAIN(Bool :h(:$help)?) { note qq:to/END_USAGE/ Zef - Perl6 Module Management USAGE zef [flags|options] command [args] zef --version COMMANDS install Install specific dependencies by name or path uninstall Uninstall specified distributions test Run tests on a given module's path fetch Fetch and extract module's source build Run the Build.pm in a given module's path look Fetch followed by shelling into the module's path update Update package indexes for repositories upgrade (BETA) Upgrade specific distributions (or all if no arguments) search Show a list of possible distribution candidates for the given terms info Show detailed distribution information browse Open browser to various support urls (homepage, bugtracker, source) list List known available distributions, or installed distributions with `--installed` depends List all direct and transitive dependencies for a given identity rdepends List all distributions directly depending on a given identity locate Lookup installed module information by short-name, name-path, or sha1 (with --sha1 flag) smoke Run smoke testing on available modules nuke Delete directory/prefix containing matching configuration path or CURLI name OPTIONS --install-to=[name] Short name or spec of CompUnit::Repository to install to --config-path=[path] Load a specific Zef config file --[phase]-timeout=[int] Set a timeout (in seconds) for the corresponding phase ( phase: fetch, extract, build, test, install ) --[phase]-degree=[int] Number of simultaneous distributions/jobs to process for the corresponding phase ( phase : fetch, test ) --update Force a refresh for all module indexes --update=[ecosystem] Force a refresh for a specific ecosystem module index --/update Skip refreshing all module indexes --/update=[ecosystem] Skip refreshing for a specific ecosystem module index ENV OPTIONS ZEF_[phase]_TIMEOUT See --[phase]-timeout ( phases: FETCH, BUILD, TEST, INSTALL ) ZEF_[phase]_DEGREE See --[phase]-degree ( phases: FETCH, TEST ) VERBOSITY LEVEL (from least to most verbose) --error, --warn, --info (default), --verbose, --debug FLAGS --deps-only Install only the dependency chains of the requested distributions --dry Run all phases except the actual installations --serial Install each dependency after passing testing and before building/testing the next dependency --contained (BETA) Install all transitive and direct dependencies regardless if they are already installed globally --/test Skip the testing phase --/build Skip the building phase --/depends Do not fetch runtime dependencies --/test-depends Do not fetch test dependencies --/build-depends Do not fetch build dependencies FORCE FLAGS Ignore errors occuring during the corresponding phase: --force-resolve --force-fetch --force-extract --force-build --force-test --force-install CONFIGURATION {$CONFIG.IO.absolute} Enable or disable plugins that match the configuration that has field `short-name` that matches -- # `--cpan` Enable plugin with short-name `cpan` --/ # `--/cpan` Disable plugin with short-name `cpan` END_USAGE } proto sub abort(|) {*} multi sub abort(Int $exit-code, Str $str) { samewith($str, $exit-code) } multi sub abort(Str $str, Int $exit-code = 255) { say $str; exit $exit-code } # Filter/mutate out verbosity flags from @*ARGS and return a verbosity level sub preprocess-args-verbosity-mutate(*@_) { my (:@log-level, :@filtered-args) := @_.classify: { $_ ~~ any(<--fatal --error --warn --info -v --verbose --debug --trace>) ?? !! ; } @*ARGS = @filtered-args; do given any(@log-level) { when '--fatal' { FATAL } when '--error' { ERROR } when '--warn' { WARN } when '--info' { INFO } when '--verbose' { VERBOSE } when '-v' { VERBOSE } when '--debug' { DEBUG } when '--trace' { TRACE } default { INFO } } } # Second crack at cli config modification # Currently only uses Bools `--name` and `--/name` to enable and disable a plugin # Note that `name` can match the config plugin key `short-name` or `module` # * Now also removes --config-path $path parameters # TODO: Turn this into a more general getopts sub preprocess-args-config-mutate(*@args) { # get/remove --config-path=xxx # MUTATES @*ARGS my Str $config-path-from-args; for |@args.flatmap(*.split(/\=/, 2)).rotor(2 => -1, :partial) { $config-path-from-args = ~$_[1] if $_[0] eq '--config-path' && $_[1]; LAST { @*ARGS = eager gather for |@args.kv -> $key, $value { take($value) unless $value.starts-with('--config-path') || ($key > 0 && @args[$key - 1] eq '--config-path') } } } my $chosen-config-file = $config-path-from-args // Zef::Config::guess-path(); # Keep track of the original path so we can show it on the --help usage :-/ my $config = do { # The .Str.IO thing is due to a weird rakudo bug I can't figure out . # A bare .IO will complain that its being called on a type Any (not true) my $path = $config-path-from-args // Zef::Config::guess-path; my $IO = $path.Str.IO; my %hash = Zef::Config::parse-file($path).hash; class :: { has $.IO; has %.hash handles ; }.new(:%hash, :$IO); } # - Move named options to start of @*ARGS so the git familiar style of options after positionals works # - get/remove --$short-name and --/$short-name where $short-name is a value in the config file my $plugin-lookup := Zef::Config::plugin-lookup($config.hash); for @*ARGS -> $arg { state @positional; state @named; LAST { @*ARGS = flat @named, @positional; } my $arg-as = $arg.subst(/^["--" | "--\/"]/, ''); my $enabled = $arg.starts-with('--/') ?? 0 !! 1; $arg.starts-with('-') ?? $arg-as ~~ any($plugin-lookup.keys) ?? (for |$plugin-lookup{$arg-as} -> $p { $p = $enabled }) !! @named.append($arg) !! @positional.append($arg); } $config; } sub get-client(*%_) { my $client = Zef::Client.new(|%_); my $logger = $client.logger; my $stdout = $logger.Supply.grep({ . <= $verbosity }); my $reporter = $logger.Supply.grep({ (. == TEST && . == AFTER) || (. == ERROR && . == AFTER) || (. == FATAL && . == AFTER) }); $stdout.tap: -> $m { given $m. { when BEFORE { say "===> {$m.}" } when AFTER { say "===> {$m.}" } default { # Prefix output with a name that references its source since # lines may be coming from many sources at once. my $line-prefix = ((.dist??.dist.meta!!Nil) // .as) with $m.; say($line-prefix ?? "[$line-prefix] $_" !! $_) for $m..lines; } } } $reporter.tap: -> $event { $client.reporter.report($event, :$logger); }; if %_.defined { my @plugins = $client.recommendation-manager.plugins; if %_ === Bool::False { @plugins.map({ try .auto-update = False }); } elsif %_ === Bool::True { @plugins.map(*.?update); } else { @plugins.grep({.short-name ~~ any(%_.grep(*.not))}).map({ try .auto-update = False }); @plugins.grep({.short-name ~~ any(%_.grep(*.so))}).map(*.?update); } } $client; } # maybe its a name, maybe its a spec/path. either way Zef::App methods take a CURs, not strings sub str2cur($target) { my $named-repo = CompUnit::RepositoryRegistry.repository-for-name($target); return $named-repo if $named-repo; # first try 'site', then try 'home' if $target eq 'auto' { state $cur = first { .can-install() }, map { CompUnit::RepositoryRegistry.repository-for-name($_) }, ; return $cur if $cur; } # Technically a path without any short-id# is a CURFS, but now it needs to be explicitly declared file# # so that the more common case can be used without the prefix (inst#). This only applies when the path # exists, so that short-names (site, home) that don't exist still throw errors instead of creating a directory. my $spec-target = $target ~~ m/^\w+\#.*?[\. | \/]/ ?? $target !! $target.IO.e ?? "inst#{$target}" !! $target; return CompUnit::RepositoryRegistry.repository-for-spec(~$spec-target, :next-repo($*REPO)); } sub path2candidate($path) { Candidate.new( as => $path, uri => $path.IO.absolute, dist => Zef::Distribution::Local.new($path), ) } # prints a table with rows and columns. expects a header row. # automatically adjusts column widths, as well as `yada`ing # any characters on a line past $max-width sub print-table(@rows, Int :$wrap) { # this ugly thing is so users can pass in Bool or Int as a MAIN argument my $max-width = ($*OUT.t && $wrap.perl eq 'Bool::False') ?? GET-TERM-COLUMNS() !! $wrap.perl eq 'Bool::True' ?? 0 !! $wrap; # returns formatted row my sub _row2str (@widths, @cells, Int :$max) { my $format = @widths.map({"%-{$_}s"}).join('|'); my $str = sprintf( $format, @cells.map({ $_ // '' }) ); return $str unless ?$max && $str.chars > $max; my $cutoff = $str.substr(0, $max || $str.chars); return $cutoff unless $cutoff.chars > 3; return ($cutoff.substr(0,*-3) ~ '...') if $cutoff.substr(*-3,3) ~~ /\S\S\S/; return ($cutoff.substr(0,*-2) ~ '..') if $cutoff.substr(*-2,2) ~~ /\S\S/; return ($cutoff.substr(0,*-1) ~ '.') if $cutoff.substr(*-1,1) ~~ /\S/; return $cutoff; } # Iterate over ([1,2,3],[2,3,4,5],[33,4,3,2]) to find the longest string in each column my sub _get_column_widths ( *@rows ) { return @rows[0].keys.map: { @rows>>[$_]>>.chars.max } } my @widths = _get_column_widths(@rows); my @fixed-rows = @rows.map: { _row2str(@widths, @$_, :max($max-width)) } if +@fixed-rows { my $width = [+] _get_column_widths(@fixed-rows); my $sep = '-' x $width; say "{$sep}\n{@fixed-rows[0]}\n{$sep}"; .say for @fixed-rows[1..*]; say $sep; } } sub parse-value($str-or-kv) { do given $str-or-kv { when Str { $_ } when Hash { $_.keys[0] } when Pair { $_.key } } } } zef-0.8.2/lib/Zef/Client.pm6000066400000000000000000001035301355757230100154530ustar00rootroot00000000000000use Zef; use Zef::Distribution; use Zef::Distribution::Local; use Zef::Distribution::DependencySpecification; use Zef::Repository; use Zef::Utils::FileSystem; use Zef::Fetch; use Zef::Extract; use Zef::Build; use Zef::Test; use Zef::Install; use Zef::Report; class Zef::Client { has $.cache; has $.indexer; has $.fetcher; has $.recommendation-manager; has $.extractor; has $.tester; has $.builder; has $.installer; has $.reporter; has $.config; has $.logger = Supplier.new; has @.exclude; # user supplied has @!ignore; # internal use has Bool $.force-resolve is rw = False; has Bool $.force-fetch is rw = False; has Bool $.force-extract is rw = False; has Bool $.force-build is rw = False; has Bool $.force-test is rw = False; has Bool $.force-install is rw = False; has Int $.fetch-degree is rw = 1; has Int $.test-degree is rw = 1; has Int $.fetch-timeout is rw = 600; has Int $.extract-timeout is rw = 3600; has Int $.build-timeout is rw = 3600; has Int $.test-timeout is rw = 3600; has Int $.install-timeout is rw = 3600; has Bool $.depends is rw = True; has Bool $.build-depends is rw = True; has Bool $.test-depends is rw = True; submethod TWEAK( :$!cache = $!config, :$!fetcher = Zef::Fetch.new(:backends(|$!config)), :$!extractor = Zef::Extract.new(:backends(|$!config)), :$!builder = Zef::Build.new(:backends(|$!config)), :$!installer = Zef::Install.new(:backends(|$!config)), :$!tester = Zef::Test.new(:backends(|$!config)), :$!reporter = Zef::Report.new(:backends(|$!config)), :$!recommendation-manager = Zef::Repository.new(:backends($!config.map({ $_ = $!cache; $_ = $!fetcher; $_ }).Slip)), ) { mkdir $!cache unless $!cache.IO.e; @!ignore = \ .map({ Zef::Distribution::DependencySpecification.new($_) }); } method find-candidates(Bool :$upgrade, *@identities ($, *@)) { self.logger.emit({ level => INFO, stage => RESOLVE, phase => BEFORE, message => "Searching for: {@identities.join(', ')}", }); my @candidates = self!find-candidates(:$upgrade, @identities); for @candidates.classify({.from}).kv -> $from, $found { self.logger.emit({ level => VERBOSE, stage => RESOLVE, phase => AFTER, message => "Found: {$found.map(*.dist.identity).join(', ')} [via {$from}]", }) } return @candidates; } method !find-candidates(Bool :$upgrade, *@identities ($, *@)) { my $candidates := $!recommendation-manager.candidates(@identities, :$upgrade)\ .grep(-> $candi { not @!exclude.first({$candi.dist.contains-spec($_)}) })\ .grep(-> $candi { not @!ignore.first({$candi.dist.contains-spec($_)}) })\ .unique(:as(*.dist.identity)); } method find-prereq-candidates(Bool :$skip-installed = True, Bool :$upgrade, *@candis ($, *@)) { my @skip = @candis.map(*.dist); my $prereqs := gather { my @specs = self.list-dependencies(@candis); while @specs.splice -> @specs-batch { self.logger.emit({ level => DEBUG, stage => RESOLVE, phase => BEFORE, message => "Dependencies: {@specs-batch.map(*.name).unique.join(', ')}", }); next unless my @needed = @specs-batch\ # The current set of specs .grep({ not @skip.first(*.contains-spec($_)) })\ # Dists in @skip are not needed .grep(-> $spec { not @!exclude.first({ $_.spec-matcher($spec) }) })\ .grep(-> $spec { not @!ignore.first({ $_.spec-matcher($spec) }) })\ .grep({ $skip-installed ?? self.is-installed($_).not !! True }); my @identities = @needed.map(*.identity); self.logger.emit({ level => INFO, stage => RESOLVE, phase => BEFORE, message => "Searching for missing dependencies: {@identities.join(', ')}", }); my @prereq-candidates = self!find-candidates(:$upgrade, @identities); my $not-found := @needed.grep({ not @prereq-candidates.first(*.dist.contains-spec($_)) }).map(*.identity); # The failing part of this should ideally be handled in Zef::CLI I think if +@prereq-candidates == +@needed || $not-found.cache.elems == 0 { for @prereq-candidates.classify({.from}).kv -> $from, $found { self.logger.emit({ level => VERBOSE, stage => RESOLVE, phase => AFTER, message => "Found dependencies: {$found.map(*.dist.identity).join(', ')} [via {$from}]", }) } } else { self.logger.emit({ level => ERROR, stage => RESOLVE, phase => AFTER, message => "Failed to find dependencies: {$not-found.join(', ')}", }); $!force-resolve ?? $!logger.emit({ level => ERROR, stage => RESOLVE, phase => LIVE, message => 'Failed to resolve missing dependencies, but continuing with --force-resolve', }) !! die('Failed to resolve some missing dependencies'); }; @skip.append: @prereq-candidates.map(*.dist); @specs = self.list-dependencies(@prereq-candidates); for @prereq-candidates -> $prereq { $prereq.is-dependency = True; take $prereq; } } } $prereqs.unique(:as(*.dist.identity)); } method fetch(*@candidates ($, *@)) { my @fetched = self!fetch(@candidates); my @extracted = self!extract(@candidates); my @local-candis = @extracted.map: -> $candi { my $dist = Zef::Distribution::Local.new(~$candi.uri); $candi.clone(:$dist); } $!recommendation-manager.store(@local-candis.map(*.dist)); @local-candis; } method !fetch(*@candidates ($, *@)) { my $dispatcher := $*PERL.compiler.version < v2018.08 ?? @candidates !! @candidates.hyper(:batch(1), :degree($!fetch-degree || 5)); my @fetched = $dispatcher.map: -> $candi { self.logger.emit({ level => DEBUG, stage => FETCH, phase => BEFORE, message => "Fetching: {$candi.as}", }); die "Cannot determine a uri to fetch {$candi.as} from. Perhaps it's META6.json is missing an e.g. source-url" unless $candi.uri; my $tmp = $!config.IO.child("{time}.{$*PID}.{(^10000).rand}"); my $stage-at = $tmp.child($candi.uri.IO.basename); die "failed to create directory: {$tmp.absolute}" unless ($tmp.IO.e || mkdir($tmp)); # $candi.uri will always point to where $candi.dist should be copied from. # It could be a file or url; $dist.source-url contains where the source was # originally located but we may want to use a local copy (while retaining # the original source-url for some other purpose like updating) my $save-to = $!fetcher.fetch($candi, $stage-at, :$!logger, :timeout($!fetch-timeout)); my $relpath = $stage-at.relative($tmp); my $extract-to = $!cache.IO.child($relpath); if !$save-to { self.logger.emit({ level => ERROR, stage => FETCH, phase => AFTER, message => "Fetching [FAIL]: {$candi.dist.?identity // $candi.as} from {$candi.uri}", }); $!force-fetch ?? $!logger.emit({ level => ERROR, stage => FETCH, phase => LIVE, candi => $candi, message => 'Failed to fetch, but continuing with --force-fetch', }) !! die("Aborting due to fetch failure: {$candi.dist.?identity // $candi.uri} (use --force-fetch to override)"); } else { self.logger.emit({ level => VERBOSE, stage => FETCH, phase => AFTER, message => "Fetching [OK]: {$candi.dist.?identity // $candi.as} to $save-to", }); } $candi.uri = $save-to; $candi; }; return @fetched; } method !extract(*@candidates ($, *@)) { my @extracted = eager gather for @candidates -> $candi { self.logger.emit({ level => DEBUG, stage => EXTRACT, phase => BEFORE, message => "Extracting: {$candi.as}", }); my $tmp = $candi.uri.parent; my $stage-at = $candi.uri; my $relpath = $stage-at.relative($tmp); my $extract-to = $!cache.IO.child($relpath); die "failed to create directory: {$tmp.absolute}" unless ($tmp.IO.e || mkdir($tmp)); my $meta6-prefix = '' R// $!extractor.ls-files($candi).sort.first({ .IO.basename eq 'META6.json' }); self.logger.emit({ level => WARN, stage => EXTRACT, phase => BEFORE, message => "Extraction: Failed to find a META6.json file for {$candi.dist.?identity // $candi.as} -- failure is likely", }) unless $meta6-prefix; my $extracted-to = $!extractor.extract($candi, $extract-to, :$!logger, :timeout($!extract-timeout)); if !$extracted-to { self.logger.emit({ level => ERROR, stage => EXTRACT, phase => AFTER, message => "Extraction [FAIL]: {$candi.dist.?identity // $candi.as} from {$candi.uri}", }); $!force-extract ?? $!logger.emit({ level => ERROR, stage => EXTRACT, phase => LIVE, candi => $candi, message => 'Failed to extract, but continuing with --force-extract', }) !! die("Aborting due to extract failure: {$candi.dist.?identity // $candi.uri} (use --force-extract to override)"); } else { try { delete-paths($tmp) } # Remove this when META.info support can finally be removed if !$meta6-prefix and my $meta-info = $extracted-to.IO.add('META.info') and $meta-info.e { self.logger.emit({ level => WARN, stage => EXTRACT, phase => AFTER, message => "Extraction: Failed to find a META6.json file for {$candi.dist.?identity // $candi.as} -- creating it from deprecated META.info file", }); try { $meta-info.copy($meta-info.parent.add('META6.json')) } } self.logger.emit({ level => VERBOSE, stage => EXTRACT, phase => AFTER, message => "Extraction [OK]: {$candi.as} to {$extract-to}", }); } $candi.uri = $extracted-to.child($meta6-prefix); take $candi; } } # xxx: needs some love. also an entire specification method build(*@candidates ($, *@)) { my @built = eager gather for @candidates -> $candi { my $dist := $candi.dist; unless $!builder.build-matcher($dist) { self.logger.emit({ level => DEBUG, stage => BUILD, phase => BEFORE, message => "# SKIP: No need to build {$candi.dist.?identity // $candi.as}", }); take $candi; next(); } $!logger.emit({ level => INFO, stage => BUILD, phase => BEFORE, message => "Building: {$candi.dist.?identity // $candi.as}", }); my $result := $!builder.build($candi, :includes($candi.dist.metainfo // []), :$!logger, :timeout($!build-timeout)).cache; $candi.build-results = $result; if $result.grep(*.not).elems { self.logger.emit({ level => ERROR, stage => BUILD, phase => AFTER, message => "Building [FAIL]: {$candi.dist.?identity // $candi.as}", }); $!force-build ?? $!logger.emit({ level => ERROR, stage => BUILD, phase => LIVE, candi => $candi, message => 'Failed to build, but continuing with --force-build', }) !! die("Aborting due to build failure: {$candi.dist.?identity // $candi.uri} (use --force-build to override)"); } else { self.logger.emit({ level => INFO, stage => BUILD, phase => AFTER, message => "Building [OK] for {$candi.dist.?identity // $candi.as}", }); } take $candi; } @built } # xxx: needs some love method test(:@includes, *@candidates ($, *@)) { my $dispatcher := $*PERL.compiler.version < v2018.08 ?? @candidates !! @candidates.hyper(:batch(1), :degree($!test-degree || 1)); my @tested = $dispatcher.map: -> $candi { self.logger.emit({ level => INFO, stage => TEST, phase => BEFORE, message => "Testing: {$candi.dist.?identity // $candi.as}", }); my $result := $!tester.test($candi, :includes($candi.dist.metainfo // []), :$!logger, :timeout($!test-timeout)).cache; $candi.test-results = $result; if $result.grep(*.not).elems { self.logger.emit({ level => ERROR, stage => TEST, phase => AFTER, message => "Testing [FAIL]: {$candi.dist.?identity // $candi.as}", }); $!force-test ?? $!logger.emit({ level => ERROR, stage => TEST, phase => LIVE, candi => $candi, message => 'Failed to get passing tests, but continuing with --force-test', }) !! die("Aborting due to test failure: {$candi.dist.?identity // $candi.uri} (use --force-test to override)"); } else { self.logger.emit({ level => INFO, stage => TEST, phase => AFTER, message => "Testing [OK] for {$candi.dist.?identity // $candi.as}", }); } $candi; } return @tested } # xxx: needs some love method search(*@identities ($, *@), *%fields, Bool :$strict = False) { $!recommendation-manager.search(@identities, :$strict, |%fields); } method uninstall(CompUnit::Repository :@from!, *@identities) { my @specs = @identities.map: { Zef::Distribution::DependencySpecification.new($_) } eager gather for self.list-installed(@from) -> $candi { my $dist = $candi.dist; if @specs.first({ $dist.spec-matcher($_) }) { my $cur = CompUnit::RepositoryRegistry.repository-for-spec("inst#{$candi.from}", :next-repo($*REPO)); $cur.uninstall($dist.compat); take $candi; } } } method install(:@curs, *@candidates ($, *@)) { my @installed = eager gather for @candidates -> $candi { self.logger.emit({ level => INFO, stage => INSTALL, phase => BEFORE, message => "Installing: {$candi.dist.?identity // $candi.as}", }); for @curs -> $cur { KEEP self.logger.emit({ level => VERBOSE, stage => INSTALL, phase => AFTER, message => "Install [OK] for {$candi.dist.?identity // $candi.as}", }); CATCH { when /'already installed'/ { self.logger.emit({ level => INFO, stage => INSTALL, phase => AFTER, message => "Install [SKIP] for {$candi.dist.?identity // $candi.as}: {$_}", }); } default { self.logger.emit({ level => ERROR, stage => INSTALL, phase => AFTER, message => "Install [FAIL] for {$candi.dist.?identity // $candi.as}: {$_}", }); $_.rethrow; } } # Previously we put this through the deprecation CURI.install shim no matter what, # but that doesn't play nicely with relative paths. We want to keep the original meta # paths for newer rakudos so we must avoid using :absolute for the source paths by # using the newer CURI.install if available take $candi if $!installer.install($candi, :$cur, :force($!force-install), :timeout($!install-timeout)); } } return @installed; } # Unlike test/build/install/etc methods, this organizes multiples phases for multiples candidates. # Eventually this will move back to a role/task based method of managing such phase dependencies. method make-install( CompUnit::Repository :@to!, # target CompUnit::Repository Bool :$fetch = True, # try fetching whats missing Bool :$build = True, # run Build.pm (DEPRECATED..?) Bool :$test = True, # run tests Bool :$dry, # do everything *but* actually install Bool :$upgrade, # NYI Bool :$serial, *@candidates ($, *@), *%_ ) { my @curs = @to.grep: -> $cur { UNDO { self.logger.emit({ level => WARN, stage => INSTALL, phase => BEFORE, message => "CompUnit::Repository install target is not writeable/installable: {$cur}" }); } KEEP { self.logger.emit({ level => TRACE, stage => INSTALL, phase => BEFORE, message => "CompUnit::Repository install target is valid: {$cur}" }); } $cur.?can-install || next(); } die "Need a valid installation target to continue" unless ?$dry || +@curs; # XXX: Each loop block below essentially represents a phase, so they will probably # be moved into their own method/module related directly to their phase. For now # lumping them here allows us to easily move functionality between phases until we # find the perfect balance/structure. die "Must specify something to install" unless +@candidates; # Fetch Stage: # Use the results from searching Repositorys and download/fetch the distributions they point at my @fetched-candidates = eager gather for @candidates -> $store { # Note that this method of not fetching Zef::Distribution::Local means we cannot # show fetching messages that would be fired in self.fetch(|) ( such as the download uri ). # The reason it doesn't just fetch regardless is because it avoids caching local dev dists # ala `zef install .` from polluting the name/auth/api/ver namespace of the local cache. # TODO: Find a solution for the issues noted above which will resolve GH#261 "zef install should tell user where the install was from" take $_ for ($store.dist.^name.contains('Zef::Distribution::Local') || !$fetch) ?? $store !! self.fetch($store, |%_); } die "Failed to fetch any candidates. No reason to proceed" unless +@fetched-candidates; # Filter Stage: # Handle stuff like removing distributions that are already installed, that don't have # an allowable license, etc. It faces the same "fetch an alternative if available on failure" # problem outlined below under `Sort Phase` (a depends on [A, B] where A gets filtered out # below because it has the wrong license means we don't need anything that depends on A but # *do* need to replace those items with things depended on by B [which replaces A]) my @filtered-candidates = @fetched-candidates.grep: -> $candi { my $*error; self.logger.emit({ level => DEBUG, stage => FILTER, phase => BEFORE, message => "Filtering: {$candi.dist.identity}", }); KEEP $!logger.emit({ level => DEBUG, stage => FILTER, phase => AFTER, message => "Filtering [OK] for {$candi.dist.?identity // $candi.as}", }); UNDO $!logger.emit({ level => ERROR, stage => FILTER, phase => AFTER, message => "Filtering [FAIL] for {$candi.dist.?identity // $candi.as}: {$*error}", }); $*error = do given $!config { when ..?chars && any(|.) ~~ any('*', $candi.dist.meta // '') { "License blacklist configuration exists and matches {$candi.dist.meta // 'n/a'} for {$candi.dist.name}"; } when ..?chars && any(|.) ~~ none('*', $candi.dist.meta // '') { "License whitelist configuration exists and does not match {$candi.dist.meta // 'n/a'} for {$candi.dist.name}"; } } $*error.?chars; } die "All candidates have been filtered out. No reason to proceed" unless +@filtered-candidates; # Sort Phase: # This ideally also handles creating alternate build orders when a `depends` includes # alternative dependencies. Then if the first build order fails it can try to fall back # to the next possible build order. However such functionality may not be useful this late # as at this point we expect to have already fetched/filtered the distributions... so either # we fetch all alternatives (most of which would probably would not use) or do this in a way # that allows us to return to a previous state in our plan (xxx: Zef::Plan is planned) my @sorted-candidates = self.sort-candidates(@filtered-candidates, |%_); die "Something went terribly wrong determining the build order" unless +@sorted-candidates; # Setup(?) Phase: # Attach appropriate metadata so we can do --dry runs using -I/some/dep/path # and can install after we know they pass any required tests my @linked-candidates = self.link-candidates(@sorted-candidates); die "Something went terribly wrong linking the distributions" unless +@linked-candidates; my $installer = sub (*@_) { # Build Phase: my @built-candidates = ?$build ?? self.build(@_) !! @_; die "No installable candidates remain after `build` failures" unless +@built-candidates; # Test Phase: my @tested-candidates = !$test ?? @built-candidates !! self.test(@built-candidates).grep({ $!force-test || .test-results.grep(!*.so).elems == 0 }); # actually we *do* want to proceed here later so that the Report phase can know about the failed tests/build die "All candidates failed building and/or testing. No reason to proceed" unless +@tested-candidates; # Install Phase: # Ideally `--dry` uses a special unique CompUnit::Repository that is meant to be deleted entirely # and contain only the modules needed for this specific run/plan my @installed-candidates = ?$dry ?? @tested-candidates !! self.install(:@curs, @tested-candidates); # Report phase: # Handle exit codes for various option permutations like --force # Inform user of what was tested/built/installed and what failed # Optionally report to any cpan testers type service (testers.perl6.org) unless $dry { if @installed-candidates.map(*.dist).flatmap(*.scripts.keys).unique -> @bins { my $msg = "\n{+@bins} bin/ script{+@bins>1??'s'!!''}{+@bins??' ['~@bins~']'!!''} installed to:" ~ "\n" ~ @curs.map(*.prefix.child('bin')).join("\n"); self.logger.emit({ level => INFO, stage => REPORT, phase => LIVE, message => $msg, }); } } @installed-candidates; } # sub installer my @installed = ?$serial ?? @linked-candidates.map({ |$installer($_) }) !! $installer(@linked-candidates); } method list-rev-depends($identity, Bool :$indirect) { my $spec = Zef::Distribution::DependencySpecification.new($identity); my $dist = self.list-available.first(*.dist.contains-spec($spec)).?dist || return []; my $rev-deps := gather for self.list-available -> $candi { my $specs := self.list-dependencies($candi); take $candi if $specs.first({ $dist.contains-spec($_, :strict) }); } $rev-deps.unique(:as(*.dist.identity)); } method list-available(*@recommendation-manager-names) { my $available := $!recommendation-manager.available(@recommendation-manager-names); } # XXX: an idea is to make CURI install locations a Repository as well. then this method # would be grouped into the above `list-available` method method list-installed(*@curis) { my @curs = +@curis ?? @curis !! $*REPO.repo-chain.grep(*.?prefix.?e); my @repo-dirs = @curs.map({.?prefix // .path-spec.?path}).map(*.IO); #.path-spec.?path is for CUR::Unknown my @dist-dirs = @repo-dirs.map(*.child('dist')).grep(*.e); my @dist-files = @dist-dirs.map(*.IO.dir.grep(*.IO.f).Slip); my $dists := gather for @dist-files -> $file { if try { Zef::Distribution.new( |%(from-json($file.IO.slurp)) ) } -> $dist { my $cur = @curs.first: {.prefix eq $file.parent.parent} take Candidate.new( :$dist, :from($cur), :uri($file) ); } } } method list-leaves { my @installed = self.list-installed; my @dep-specs = self.list-dependencies(@installed); my $leaves := gather for @installed -> $candi { my $dist := $candi.dist; take $candi unless @dep-specs.first: { $dist.contains-spec($_) } } } method list-dependencies(*@candis, :$from) { my $deps := gather for @candis -> $candi { take $_ for grep *.defined, ($candi.dist.depends-specs if ?$!depends).Slip, ($candi.dist.test-depends-specs if ?$!test-depends).Slip, ($candi.dist.build-depends-specs if ?$!build-depends).Slip; } # if .name is not defined then its invalid but probably a deeply nested # depends hash so just ignore it since it might be valid in the near future. $deps.unique(:as(*.identity)); } method resolve($spec, :@at) { my $candis := self.list-installed(@at).grep(*.dist.contains-spec($spec)); $candis.sort(*.dist.ver).sort(*.dist.api).reverse; } method is-installed($spec, |c) { do given $spec.?from-matcher { when 'bin' { so Zef::Utils::FileSystem::which($spec.name) } when 'native' { so self!native-library-is-installed($spec.name) } default { so self.resolve($spec, |c).so } } } method !native-library-is-installed(Str() $lib --> Bool) { use NativeCall; my $throwaway-sub = sub { }; $throwaway-sub does NativeCall::Native[$throwaway-sub, sub { $*VM.platform-library-name($lib.IO).basename }]; try { CATCH { default { return False if .payload.starts-with("Cannot locate native library") } } $throwaway-sub(); } return True; } method sort-candidates(@candis, *%_) { my @tree; my $visit = sub ($candi, $from? = '') { return if ($candi.dist.metainfo // 0) == 1; if ($candi.dist.metainfo // 0) == 0 { $candi.dist.metainfo = 1; my @deps = |self.list-dependencies($candi); for @deps -> $m { for @candis.grep(*.dist.contains-spec($m)) -> $m2 { $visit($m2, $candi); } } @tree.append($candi); } }; for @candis -> $candi { $visit($candi, 'olaf') if ($candi.dist.metainfo // 0) == 0; } .dist.metainfo = Nil for @tree; return @tree; } # Adds appropriate include (-I / PERL6LIB) paths for dependencies # This should probably be handled by the Candidate class... one day... proto method link-candidates(|) {*} multi method link-candidates(Bool :$recursive! where *.so, *@candidates) { # :recursive # Given Foo::XXX that depends on Bar::YYY that depends on Baz::ZZZ # - Foo::XXX -> -I/Foo/XXX -I/Bar/YYY -I/Baz/ZZZ # - Bar::YYY -> -I/Bar/YYY -I/Baz/ZZZ # - Baz::ZZZ -> -I/Baz/ZZZ # XXX: Need to change this so it only add indirect dependencies # instead of just recursing the array in order. Otherwise there # can be distributions that are part of a different dependency # chain will end up with some extra includes my @linked = self.link-candidates(@candidates); @ = @linked.map: -> $candi { # can probably use rotor instead of doing the `@a[$index + 1..*]` dance my @direct-includes = $candi.dist.metainfo.grep(*.so); my @recursive-includes = try @linked[(state $i += 1)..*]\ .map(*.dist.metainfo).flatmap(*.flat); my @unique-includes = unique(@direct-includes, @recursive-includes); $candi.dist.metainfo = @unique-includes.grep(*.so); $candi; } } multi method link-candidates(Bool :$inclusive! where *.so, *@candidates) { # :inclusive # Given Foo::XXX that depends on Bar::YYY that depends on Baz::ZZZ # - Foo::XXX -> -I/Foo/XXX -I/Bar/YYY -I/Baz/ZZZ # - Bar::YYY -> -I/Foo/XXX -I/Bar/YYY -I/Baz/ZZZ # - Baz::ZZZ -> -I/Foo/XXX -I/Bar/YYY -I/Baz/ZZZ my @linked = self.link-candidates(@candidates); @ = @linked.map(*.dist.metainfo).flatmap(*.flat).unique; } multi method link-candidates(*@candidates) { # Default # Given Foo::XXX that depends on Bar::YYY that depends on Baz::ZZZ # - Foo::XXX -> -I/Foo/XXX -I/Bar/YYY # - Bar::YYY -> -I/Bar/YYY -I/Baz/ZZZ # - Baz::ZZZ -> -I/Baz/ZZZ @ = @candidates.map: -> $candi { my $dist := $candi.dist; my @dep-specs = |self.list-dependencies($candi); # this could probably be done in the topological-sort itself my $includes := eager gather DEPSPEC: for @dep-specs -> $spec { for @candidates -> $fcandi { my $fdist := $fcandi.dist; if $fdist.contains-spec($spec) { take $fdist.IO.absolute; take $_ for |$fdist.metainfo.grep(*.so); next DEPSPEC; } } } $dist.metainfo = $includes.unique.cache; $candi; } } } zef-0.8.2/lib/Zef/Config.pm6000066400000000000000000000033351355757230100154440ustar00rootroot00000000000000use Zef; unit module Zef::Config; our sub parse-file($path) { my %config = %(from-json( $path.IO.slurp )); %config{$_.key} = $_.value.subst(/'{$*HOME}' || '$*HOME'/, $*HOME // $*TMPDIR, :g)\ for %config.grep(*.key.ends-with('Dir')); %config //= 'auto'; # XXX: config upgrade - just remove this in future when no one is looking %config //= %config:delete; %config; } our sub guess-path { my %default-conf; my IO::Path $local-conf-path; my @path-candidates = ( (%*ENV // "$*HOME/.config").IO.child('/zef/config.json'), %?RESOURCES.IO, ); for @path-candidates -> $path { if $path.e { %default-conf = try { parse-file($path) } // Hash.new; die "Failed to parse the zef config file '$path'" if !%default-conf; $local-conf-path = $path; last; } } die "Failed to find the zef config file at: {@path-candidates.join(', ')}" unless $local-conf-path.defined and $local-conf-path.e; die "Failed to parse a zef config file at $local-conf-path" if !%default-conf; return $local-conf-path; } our sub plugin-lookup($config) { my $lookup; my sub do-lookup($node) { if $node ~~ Hash { for @$node -> $sub-node { if $sub-node.value ~~ Str | Int && $sub-node.key eq any() { $lookup{$sub-node.value}.push($node); next; } do-lookup($sub-node.value); } } elsif $node ~~ Array { do-lookup($_) for $node.cache; } } do-lookup($config); $lookup; } zef-0.8.2/lib/Zef/Distribution.pm6000066400000000000000000000124361355757230100167200ustar00rootroot00000000000000use Zef; use Zef::Distribution::DependencySpecification; use Zef::Utils::SystemQuery; class Zef::Distribution does Distribution is Zef::Distribution::DependencySpecification { has $.meta-version; has $.name; has $.auth; has $.author; has $.authority; has $.api; has $.ver; has $.version; has $.description; has $.depends; has %.provides; has %.files; has $.source-url; has $.license; has $.build-depends; has $.test-depends; has @.resources; has %.support; has $.builder; has $.meta; # Holds a copy of the original meta data so we don't lose non-spec meta fields like 'build' # attach arbitrary data, like for topological sort, that won't be saved on install has %.metainfo is rw; method new(*%_) { self.bless(|%_, :meta(%_)) } method TWEAK(--> Nil) { @!resources = @!resources.flatmap(*.flat); } method auth { with $!auth // $!author // $!authority { .Str } else { Nil } } method ver { with $!ver // $!version { $!ver ~~ Version ?? $_ !! $!ver = Version.new($_ // 0) } } method api { with $!api { $!api ~~ Version ?? $_ !! $!api = Version.new($_ // 0) } } method hash { my %normalized = %( :$!meta-version, :$!name, :$.auth, :$.ver, :$.api, :$!description, :$!depends, :$!build-depends, :$!test-depends, :%!provides, :%!files, :@!resources, :$!license, :%!support, :$!source-url, :$.builder, ); # Add non-spec keys back into the has output ( will do this properly when refactoring Distribution ) %normalized{$_} //= $!meta{$_} for $!meta.hash.keys; %normalized:delete unless %normalized; %normalized:delete unless %normalized; return %normalized; } # make matching dependency names against a dist easier # when sorting the install order from the meta hash method depends-specs { my $deps := $.depends ~~ Hash ?? $.depends.grep(*.defined).grep(*.).map(*.).map(*.Slip) !! $.depends; $deps.grep(*.defined).map({ Zef::Distribution::DependencySpecification.new(system-collapse($_)) }).grep(*.name); } method build-depends-specs { gather { for $.build-depends.grep(*.defined) { with Zef::Distribution::DependencySpecification.new(system-collapse($_)) { take $_ if $_.name; } } } } method test-depends-specs { gather for $.test-depends.grep(*.defined) { with Zef::Distribution::DependencySpecification.new(system-collapse($_)) { take $_ if $_.name; } } } # make locating a module that is part of a distribution (ex. URI::Escape of URI) easier. # it doesn't need to be a hash mapping as its just for matching has @!provides-specs; method provides-specs { @!provides-specs := +@!provides-specs ?? @!provides-specs !! @(self.hash).map({ # if $spec.name is not defined then .key (the module name of the current provides) # is not a valid module name (according to Zef::Identity grammar anyway). I ran into # this problem with `NativeCall::Errno` where one of the provides was: `X:NativeCall::Errorno` # The single colon cannot just be fixed to DWIM because that could just as easily denote # an identity part (identity parts are separated by a *single* colon; double colon is left alone) my $spec = Zef::Distribution::DependencySpecification.new(self!long-name(.key)); next unless defined($spec.name); $spec; }).grep(*.defined).Slip; } method provides-spec-matcher($spec, :$strict) { self.provides-specs.first({ ?$_.spec-matcher($spec, :$strict) }) } proto method contains-spec(|) {*} multi method contains-spec(Str $spec, |c) { samewith( Zef::Distribution::DependencySpecification.new($spec, |c) ) } multi method contains-spec(Zef::Distribution::DependencySpecification $spec, Bool :$strict = True) { so self.spec-matcher($spec, :$strict) || self.provides-spec-matcher($spec, :$strict) } method Str { return self!long-name($!name); } method !long-name($name!) { return "{$name}:ver<{$.ver // ''}>:auth<{$.auth // ''}>:api<{$.api // ''}>"; } method id() { use nqp; return nqp::sha1(self.Str); } method WHICH(Zef::Distribution:D:) { "{self.^name}|{self.Str()}" } # For now we will use $dist.compat in spots where we pass to rakudo and there # are Distribution constraints (install and uninstall?). This provides backwards compatibility # until a more robust solution is worked out method compat { (::("Distribution::Hash").new(self.?meta || $.hash, :prefix(self.?IO // $*CWD)) but role { method name { self.meta } method ver { self.meta // self.meta } method auth { self.meta } }); } method meta { $.hash } method content($name-path) { self.compat.content($name-path) } } zef-0.8.2/lib/Zef/Distribution/000077500000000000000000000000001355757230100162665ustar00rootroot00000000000000zef-0.8.2/lib/Zef/Distribution/DependencySpecification.pm6000066400000000000000000000041411355757230100234710ustar00rootroot00000000000000use Zef::Identity; class Zef::Distribution::DependencySpecification { has $!ident; has $.spec; # todo: handle wildcard/+ (like "1.2.3+", "1.2.*", "*:ugexe", "github:*") submethod new($spec) { self.bless(:$spec) } method identity { my $hash = %(:name($.name), :ver($.version-matcher), :auth($.auth-matcher), :api($.api-matcher), :from($.from-matcher)); my $identity = hash2identity( $hash ); $identity; } method clone(|) { $!ident = Nil; nextsame(); } method spec-parts(Zef::Distribution::DependencySpecification:_: $spec = self!spec) { # Need to find a way to break this cache when a distribution gets cloned with a different version $!ident //= Zef::Identity.new(|$spec); $!ident.?hash; } method name { self.spec-parts } method version-matcher { self.spec-parts // '*' } method auth-matcher { self.spec-parts // '' } method api-matcher { self.spec-parts // '*' } method from-matcher { self.spec-parts // '' } method !spec { $.spec || self.Str } method spec-matcher($spec, Bool :$strict = True) { return False unless $spec.name.?chars && self.name.?chars; if $strict { return False unless $spec.name eq self.name; } else { my $name = $spec.name; return False unless self.name ~~ /[:i $name]/; } if $spec.version-matcher.chars && $spec.version-matcher ne '*' { my $spec-version = Version.new($spec.version-matcher); my $self-version = Version.new($.version-matcher); return False unless ?$.version-matcher && $.version-matcher ne '*' && $self-version ~~ $spec-version; } if $spec.auth-matcher.chars { return False unless $.auth-matcher.chars && $spec.auth-matcher eq $.auth-matcher; } if $spec.api-matcher.chars && $.api-matcher ne '*' { return False unless Version.new($spec.api-matcher) ~~ Version.new($.api-matcher); } return True; } } zef-0.8.2/lib/Zef/Distribution/Local.pm6000066400000000000000000000111601355757230100177430ustar00rootroot00000000000000use Zef; use Zef::Distribution; class Zef::Distribution::Local is Zef::Distribution { has $.path; has $.IO; # if $path = dir/meta6.json, $.path is set to dir # if $path = dir/, $.path is set to the first meta file (if any) thats found method new($path) { die "Cannot create a Zef::Distribution from non-existent path: {$path}" unless $path.IO.e; my $meta-path = self.find-meta($path) || die "No meta file? Path: {$path}"; my $abspath = $meta-path.parent.absolute; my %meta = try { %(from-json($meta-path.slurp)) } || die "Invalid json? File: {$meta-path}"; my $IO = $abspath.IO; self.bless(:path($abspath), :$IO, |%(%meta.grep(?*.value.elems)), :meta(%meta)); } method find-meta(Zef::Distribution::Local: $path? is copy) { my $dir = $path ~~ IO::Path # Purpose: Turn whatever the user gives us to a IO::Path if possible ?? $path # - Already IO::Path !! $path.?chars # - If $path is Any it won't have .chars (hence .?chars) ?? $path.IO # - A string with at least 1 char is needed to call `.IO` !! self.IO; # - Assume its meant to be called on itself (todo: check $path.defined) # If a file was passed in then we assume its a metafile. Normally you'd pass # in a directory containing the meta file, but for convience we'll do this for files return $dir if !$dir || $dir.IO.f; # META.info and META6.info are not spec, but are still in use. # The windows path size check is for windows symlink wonkiness. # "12" is the minimum size required for a valid meta that # rakudos internal json parser can understand (and is longer than # what the symlink issue noted above usually involves) my $meta-variants = .map: { $ = $dir.child($_) } my $chosen-meta = $meta-variants.grep(*.IO.e).first: -> $file { so ($file.e && ($*DISTRO.is-win ?? ((try $file.s) > 12) !! $file.f)); } || IO::Path; } method resources(Bool :$absolute) { my $res-path = self.IO.child('resources'); # resources/libraries is treated differently than everything else. # It uses the internal platform-library-name method to apply an # automatic platform naming scheme to the paths. It maps the original # path to this new path so that CURI.install can understand it. # Example: # META FILE: 'resources/libraries/mylib' # GENERATED: 'resources/libraries/mylib' => 'resources/libaries/libmylib.so' # or 'resources/libraries/mylib' => 'resources/libaries/mylib.dll' # Note that it does not add the "lib" prefix on Windows. Whether the generated file has the "lib" prefix is platform dependent. my $lib-path = $res-path.child('libraries'); % = self.hash.map: -> $resource { my $resource-path = $resource ~~ m/^libraries\/(.*)/ ?? $lib-path.child($*VM.platform-library-name(IO::Path.new($0, :CWD($!path)))) !! $res-path.child($resource); $resource => $resource-path.IO.is-relative ?? ( ?$absolute ?? $resource-path.IO.absolute($!path) !! $resource-path ) !! ( !$absolute ?? $resource-path.IO.relative($!path) !! $resource-path ); } } method sources(Bool :$absolute) { # Re-map the module name to file path, possibly absolutifying the path % = self.hash.grep(*.so).map: { .key => .value.IO.is-relative ?? ( ?$absolute ?? .value.IO.absolute($!path) !! .value ) !! ( !$absolute ?? .value.IO.relative($!path) !! .value ); } } method scripts(Bool :$absolute) { % = do with $.IO.child('bin') -> $bin { # Get all files in bin/ directory and map them into # a hash CURI.install understands: "zef" => "bin/zef" $bin.dir.grep(*.IO.f).map({ $_.IO.basename => $_.IO.is-relative ?? ( ?$absolute ?? $_.IO.absolute($!path) !! $_ ) !! ( !$absolute ?? $_.IO.relative($!path) !! $_ ) }).hash if $bin.IO.d } } method meta { my %hash = self.hash; self.resources.map: { %hash{"resources/" ~ .key} = .value } self.scripts.map: { %hash{"bin/" ~ .key} = .value } %hash; } method content($address) { my $handle = IO::Handle.new: path => IO::Path.new($address, :CWD(self.IO)); $handle // $handle.throw; } } zef-0.8.2/lib/Zef/Extract.pm6000066400000000000000000000063621355757230100156540ustar00rootroot00000000000000use Zef; use Zef::Utils::FileSystem; class Zef::Extract does Pluggable { submethod TWEAK(|) { @ = self.plugins; # preload plugins } method extract-matcher($path) { self.plugins.grep(*.extract-matcher($path)) } method extract($candi, $extract-to, Supplier :$logger, Int :$timeout) { my $path := $candi.uri; die "Can't extract non-existent path: {$path}" unless $path.IO.e; die "Can't extract to non-existent path: {$extract-to}" unless $extract-to.IO.e || $extract-to.IO.mkdir; my $extractors = self!extractors($path).map(-> $extractor { if ?$logger { $logger.emit({ level => DEBUG, stage => EXTRACT, phase => START, candi => $candi, message => "Extracting with plugin: {$extractor.^name}" }); $extractor.stdout.Supply.act: -> $out { $logger.emit({ level => VERBOSE, stage => EXTRACT, phase => LIVE, candi => $candi, message => $out }) } $extractor.stderr.Supply.act: -> $err { $logger.emit({ level => ERROR, stage => EXTRACT, phase => LIVE, candi => $candi, message => $err }) } } my $out = lock-file-protect("{$extract-to}.lock", -> { my $todo = start { try $extractor.extract($path, $extract-to) }; my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new); await Promise.anyof: $todo, $time-up; $logger.emit({ level => DEBUG, stage => EXTRACT, phase => LIVE, candi => $candi, message => "Testing $path timed out" }) if ?$logger && $time-up.so && $todo.not; $todo.so ?? $todo.result !! Nil }); # really just saving $extractor for an error message later on. should do away with it later $extractor => $out; }); # gnu tar on windows doesn't always work as I expect, so try another plugin if extraction fails my $extracted-to = $extractors.grep({ $logger.emit({ level => WARN, stage => EXTRACT, phase => LIVE, candi => $candi, message => "Extracting with plugin {.key.^name} aborted." }) if ?$logger && !(.value.defined && .value.IO.e); .value.defined && .value.IO.e; }).map(*.value).head; die "something went wrong extracting {$path} to {$extract-to} with {$.plugins.join(',')}" unless $extracted-to.IO.e; return $extracted-to.IO; } method ls-files($candi, :$logger) { my $path := $candi.uri; my $extractors := self!extractors($path); my $name-paths := $extractors.map(*.ls-files($path)).first(*.defined).map(*.IO); $name-paths.map({ .is-absolute ?? $path.child(.relative($path)).cleanup.relative($path) !! $_ }); } method !extractors($path) { my $extractors := self.extract-matcher($path).cache; unless +$extractors { my @report_enabled = self.plugins.map(*.short-name); my @report_disabled = self.backends.map(*.).grep({ $_ ~~ none(@report_enabled) }); die "Enabled extracting backends [{@report_enabled}] don't understand $path\n" ~ "You may need to configure one of the following backends, or install its underlying software - [{@report_disabled}]"; } $extractors; } } zef-0.8.2/lib/Zef/Fetch.pm6000066400000000000000000000037321355757230100152710ustar00rootroot00000000000000use Zef; use Zef::Utils::FileSystem; use Zef::Utils::URI; class Zef::Fetch does Pluggable { submethod TWEAK(|) { @ = self.plugins; # preload plugins } method fetch-matcher($uri) { self.plugins.grep(*.fetch-matcher($uri)) } method fetch($candi, $save-to, Supplier :$logger, Int :$timeout) { my $uri := $candi.uri; my $fetchers := self.fetch-matcher($uri).cache; unless +$fetchers { my @report_enabled = self.plugins.map(*.short-name); my @report_disabled = self.backends.map(*.).grep({ $_ ~~ none(@report_enabled) }); die "Enabled fetching backends [{@report_enabled}] don't understand $uri\n" ~ "You may need to configure one of the following backends, or install its underlying software - [{@report_disabled}]"; } my $got := $fetchers.map: -> $fetcher { if ?$logger { $logger.emit({ level => DEBUG, stage => FETCH, phase => START, candi => $candi, message => "Fetching $uri with plugin: {$fetcher.^name}" }); $fetcher.stdout.Supply.act: -> $out { $logger.emit({ level => VERBOSE, stage => FETCH, phase => LIVE, candi => $candi, message => $out }) } $fetcher.stderr.Supply.act: -> $err { $logger.emit({ level => ERROR, stage => FETCH, phase => LIVE, candi => $candi, message => $err }) } } my $ret = lock-file-protect("{$save-to}.lock", -> { my $todo = start { try $fetcher.fetch($uri, $save-to) }; my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new); await Promise.anyof: $todo, $time-up; $logger.emit({ level => DEBUG, stage => FETCH, phase => LIVE, candi => $candi, message => "Fetching $uri timed out" }) if ?$logger && $time-up.so && $todo.not; $todo.so ?? $todo.result !! Nil; }); $ret; } return $got.first(*.so); } } zef-0.8.2/lib/Zef/Identity.pm6000066400000000000000000000053421355757230100160300ustar00rootroot00000000000000class Zef::Identity { has $.name; has $.version; has $.auth; has $.api; has $.from; method CALL-ME($id) { once { note 'Zef::Identity(...) is deprecated. Use Zef::Identity.new(...) instead' } try self.new(|$id) } my grammar REQUIRE { regex TOP { ^^ [':' ]* $$ } regex name { <-restricted +name-sep>+ } token key { <-restricted>+ } token value { '<' ~ '>' [<( [[ |\\> . ]+]* % ['\\' . ] )>] } token restricted { [':' | '<' | '>' | '(' | ')'] } token name-sep { < :: > } } my class REQUIRE::Actions { method TOP($/) { make %('name'=> $/.made, %($/ Z=> $/>>.ast)) if $/ } method name($/) { make $/.Str } method key($/) { my $str = make $/.Str; ($str eq 'ver') ?? 'version' !! $str } method value($/) { make $/.Str } } proto method new(|) {*} multi method new(Str :$name!, :ver(:$version), :$auth, :$api, :$from) { self.bless(:$name, :$version, :$auth, :$api, :$from); } multi method new(Str $id) { if $id.starts-with('.' | '/') { self.bless( name => $id, version => '', auth => '', api => '', from => '', ); } elsif REQUIRE.parse($id, :actions(REQUIRE::Actions)).ast -> $ident { self.bless( name => ~($ident // ''), version => ~($ident.first(*.defined) // ''), auth => ~($ident // ''), api => ~($ident // ''), from => ~($ident || 'Perl6'), ); } } # Acme::Foo::SomeModule:auth:ver('1.0') method identity { $!name ~ (($!version // '' ) ne ('*' | '') ?? ":ver<" ~ $!version ~ ">" !! '') ~ (($!auth // '' ) ne ('*' | '') ?? ":auth<" ~ $!auth ~ ">" !! '') ~ (($!api // '' ) ne ('*' | '') ?? ":api<" ~ $!api ~ ">" !! '') ~ (($!from // '' ) ne ('Perl6' | '') ?? ":from<" ~ $!from ~ ">" !! ''); } method hash { my %hash; %hash = $!name // ''; %hash = $!version // ''; %hash = $!auth // ''; %hash = $!api // ''; %hash = $!from // ''; %hash; } } sub str2identity($str) is export { # todo: when $str is a path Zef::Identity.new($str).?identity // $str; } sub identity2hash($identity) is export { Zef::Identity.new($identity).?hash; } sub hash2identity($hash) is export { Zef::Identity.new(|$hash).?identity; } zef-0.8.2/lib/Zef/Install.pm6000066400000000000000000000026651355757230100156520ustar00rootroot00000000000000use Zef; class Zef::Install does Pluggable { submethod TWEAK(|) { @ = self.plugins; # preload plugins } method install-matcher($dist) { self.plugins.grep(*.install-matcher($dist)) } method install($candi, :$cur, :$force, Supplier :$logger, Int :$timeout) { my $dist = $candi.dist; my $installer = self.install-matcher($dist).first(*.so); die "No installing backend available" unless ?$installer; if ?$logger { $logger.emit({ level => DEBUG, stage => INSTALL, phase => START, candi => $candi, message => "Installing with plugin: {$installer.^name}" }); $installer.stdout.Supply.grep(*.defined).act: -> $out { $logger.emit({ level => VERBOSE, stage => INSTALL, phase => LIVE, candi => $candi, message => $out }) } $installer.stderr.Supply.grep(*.defined).act: -> $err { $logger.emit({ level => ERROR, stage => INSTALL, phase => LIVE, candi => $candi, message => $err }) } } my $todo = start { $installer.install($dist.compat, :$cur, :$force) }; my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new); await Promise.anyof: $todo, $time-up; $logger.emit({ level => DEBUG, stage => INSTALL, phase => LIVE, candi => $candi, message => "Installing {$dist.path} timed out" }) if ?$logger && $time-up.so && $todo.not; my $got = $todo.so ?? $todo.result !! False; return $got; } } zef-0.8.2/lib/Zef/Report.pm6000066400000000000000000000016621355757230100155130ustar00rootroot00000000000000use Zef; class Zef::Report does Pluggable does Reporter { submethod TWEAK(|) { @ = self.plugins; # preload plugins } method report($candi, Supplier :$logger) { my $reporters := self.plugins.grep(*.so).cache; my @reports = $reporters.map: -> $reporter { if ?$logger { $logger.emit({ level => DEBUG, stage => REPORT, phase => START, candi => $candi, message => "Reporting with plugin: {$reporter.^name}" }); $reporter.stdout.Supply.act: -> $out { $logger.emit({ level => VERBOSE, stage => REPORT, phase => LIVE, candi => $candi, message => $out }) } $reporter.stderr.Supply.act: -> $err { $logger.emit({ level => ERROR, stage => REPORT, phase => LIVE, candi => $candi, message => $err }) } } my $report = try $reporter.report($candi.dist); $report; } return @reports.grep(*.defined); } } zef-0.8.2/lib/Zef/Repository.pm6000066400000000000000000000076271355757230100164260ustar00rootroot00000000000000use Zef; class Zef::Repository does Pluggable { submethod TWEAK(|) { @ = self.plugins; # preload plugins } method candidates(Bool :$upgrade, *@identities ($, *@)) { # todo: have a `file` identity in Zef::Identity my @searchable = @identities.grep({ not $_.starts-with("." | "/") }); # XXX: Delete this eventually my $dispatchers := $*PERL.compiler.version < v2018.08 ?? self!plugins !! self!plugins.race(:batch(1)); my @unsorted-candis = $dispatchers.map: -> $storage { # todo: (cont. from above): Each Repository should just filter this themselves my @search-for = $storage.id eq 'Zef::Repository::LocalCache' ?? @identities !! @searchable; $storage.search(@search-for, :strict).Slip } my @unsorted-grouped-candis = @unsorted-candis.categorize({.dist.name}).values; # Take the distribution with the highest version out of all matching distributions from each repository my @partially-sorted-candis = @unsorted-grouped-candis.map: -> $candis { my @presorted = $candis.sort(*.dist.api).sort(*.dist.ver); my $api = @presorted.tail.dist.api; my $version = @presorted.tail.dist.ver; # Prefer candidates from Zef::Repository::Local to avoid redownloading cached items my @sorted = @presorted.grep({ .dist.api eq $api }).grep({ .dist.ver eq $version }).sort({ $^a.from eq 'Zef::Repository::LocalCache' }); @sorted.tail; } # Sort the highest distribution versions from each repository. This must be done # before the call to `.unique` later so that unique doesn't remove the higher # versioned distribution based on randomness of @unsorted-candis.categorize({.dist.name}).values my @sorted-candis = @partially-sorted-candis.sort(*.dist.ver).sort(*.dist.api).reverse; # $candi.as tells us what string was used to request its distribution ($candi.dist) # So this is similar to the .categorize(*.dist.name) filter above, except it # covers when two different repositories have a matching candidate with different # distribution names (likely matching *module* names in provides) my @distinct-requested-as = @sorted-candis.unique(:as(*.as)); return @distinct-requested-as; } method search(:$max-results = 5, Bool :$strict, *@identities ($, *@), *%fields) { return () unless @identities || %fields; # XXX: Delete this eventually my $dispatcher := $*PERL.compiler.version < v2018.08 ?? self!plugins !! self!plugins.race(:batch(1)); my @unsorted-candis = $dispatcher.map: -> $storage { $storage.search(@identities, |%fields, :$max-results, :$strict).Slip } return @unsorted-candis; } method store(*@dists) { for self!plugins.grep(*.^can('store')) -> $storage { $storage.?store(@dists); } } method available(*@plugins) { my @can-available = self!plugins(@plugins).grep: -> $plugin { note "Plugin '{$plugin.short-name}' does not support `.available` -- Skipping" unless $plugin.can('available'); # UNDO doesn't work here yet $plugin.can('available'); } my @available = @can-available.race(:batch(1)).map({ $_.available.Slip }); return @available; } method update(*@plugins) { my @can-update = self!plugins(@plugins).grep: -> $plugin { note "Plugin '{$plugin.short-name}' does not support `.update` -- Skipping" unless $plugin.can('update'); # UNDO doesn't work here yet $plugin.can('update'); } my %updates = @can-update.race(:batch(1)).map({ $_.id => $_.update.elems }).hash; return %updates; } method !plugins(*@_) { +@_ ?? self.plugins.grep({.short-name ~~ any(@_)}) !! self.plugins } } zef-0.8.2/lib/Zef/Repository/000077500000000000000000000000001355757230100157665ustar00rootroot00000000000000zef-0.8.2/lib/Zef/Repository/Ecosystems.pm6000066400000000000000000000100451355757230100205500ustar00rootroot00000000000000use Zef; use Zef::Utils::FileSystem; use Zef::Distribution; use Zef::Distribution::DependencySpecification; class Zef::Repository::Ecosystems does Repository { has $.name; has $.mirrors; has $.auto-update is rw; has $.fetcher; has $.cache; has $.update-counter; has @!dists; method id(--> Str) { $?CLASS.^name.split('+', 2)[0] ~ "<{$!name}>" } method IO(--> IO::Path) { my $dir = $!cache.IO.child($!name); $dir.mkdir unless $dir.e; $dir } method available(--> Seq) { self!gather-dists.map: -> $dist { Candidate.new( dist => $dist, uri => ($dist.source-url || $dist.hash), from => self.id, as => $dist.identity, ); } } method update { $!update-counter++; $!mirrors.first: -> $uri { # TODO: use the logger to send these as events note "===> Updating $!name mirror: $uri"; UNDO note "!!!> Failed to update $!name mirror: $uri"; KEEP note "===> Updated $!name mirror: $uri"; KEEP self!gather-dists; my $save-as = $!cache.IO.child($uri.IO.basename); my $saved-as = try $!fetcher.fetch(Candidate.new(:$uri), $save-as, :timeout(180)); next unless $saved-as.?chars && $saved-as.IO.e; # this is kinda odd, but if $path is a file, then its fetching via http from p6c.org # and if its a directory its pulling from my ecosystems repo (this hides the difference for now) $saved-as .= child("{$!name}.json") if $saved-as.d; next unless $saved-as.e; lock-file-protect("{$saved-as}.lock", -> { self!spurt-package-list($saved-as.slurp(:bin)) }); } self!gather-dists; } # todo: handle %fields # todo: search for up to $max-results number of candidates for each *dist* (currently only 1 candidate per identity) method search(:$max-results = 5, Bool :$strict, *@identities, *%fields) { return ().Seq unless @identities || %fields; my %specs = @identities.map: { $_ => Zef::Distribution::DependencySpecification.new($_) } my @searchable-identities = %specs.classify({ .value.from-matcher }).grep(*.defined).hash.keys; return ().Seq unless @searchable-identities; # XXX: Delete this eventually my $dispatchers := $*PERL.compiler.version < v2018.08 ?? self!gather-dists !! self!gather-dists.race; my @matches = $dispatchers.map: -> $dist { @searchable-identities.grep({ $dist.contains-spec(%specs{$_}, :$strict) }).map({ Candidate.new( dist => $dist, uri => ($dist.source-url || $dist.hash), as => $_, from => self.id, ); }).Slip } return @matches; } method !package-list-path(--> IO::Path) { self.IO.child($!name ~ '.json') } method !slurp-package-list(--> List) { return [ ] unless self!package-list-path.e; do given self!package-list-path.open(:r) { LEAVE {.close} .lock: :shared; try |from-json(.slurp); } } method !spurt-package-list($content --> Bool) { do given self!package-list-path.open(:w) { LEAVE {.close} .lock; try .spurt($content); } } method !is-package-list-stale { return !self!package-list-path.e || ($!auto-update && self!package-list-path.modified < now.DateTime.earlier(:hours($!auto-update)).Instant); } # Abstraction to handle automatic updating of package list and/or local index method !gather-dists(--> List) { self.update if !$!update-counter && self!is-package-list-stale; return @!dists if +@!dists; @!dists = eager gather for self!slurp-package-list -> $meta { take($_) with try Zef::Distribution.new(|%($meta)); } } }zef-0.8.2/lib/Zef/Repository/LocalCache.pm6000066400000000000000000000104471355757230100203760ustar00rootroot00000000000000use Zef; use Zef::Distribution::Local; use Zef::Distribution::DependencySpecification; use Zef::Utils::FileSystem; # Intended to: # 1) Keep track of contents of a directory using a manifest. # a) full update to recursively search location to discover everything # b) .store method to be called after something is fetched, allowing # the single entry to be added to the manifest without having to search # 2) If a requested identity matches anything found in the manifest already # then it will return *that* instead of necessarily making net requests # for other Repository like p6c or CPAN (although such choices are # made inside Zef::Repository itself) class Zef::Repository::LocalCache does Repository { has $.mirrors; has $.auto-update is rw; has $.cache; has @!dists; method IO(--> IO::Path) { my $dir = $!cache.IO; $dir.mkdir unless $dir.e; $dir } method available(--> Seq) { self!gather-dists.map: -> $dist { Candidate.new( dist => $dist, uri => ($dist.source-url || $dist.hash), from => self.id, as => $dist.identity, ); } } # Rebuild the manifest/index by recursively searching for META files method update { LEAVE { self.store(@!dists) } self!update; self!gather-dists; } method !update(-->Bool) { # $.cache/level1/level2/ # dirs containing dist files my @dirs = $!cache.IO.dir.grep(*.d).map(*.dir.Slip).grep(*.d); my @dists = grep { .defined }, map { try Zef::Distribution::Local.new($_) }, @dirs; my $content = join "\n", @dists.map: { join "\0", (.identity, .path) } so $content ?? self!spurt-package-list($content) !! False; } # todo: handle %fields # note this doesn't apply the $max-results per identity searched, and always returns a 1 dist # max for a single identity (todo: update to handle $max-results for each @identities) method search(:$max-results = 5, Bool :$strict, *@identities, *%fields --> Seq) { return ().Seq unless @identities || %fields; my %specs = @identities.map: { $_ => Zef::Distribution::DependencySpecification.new($_) } my @searchable-identities = %specs.classify({ .value.from-matcher }).grep(*.defined).hash.keys; return ().Seq unless @searchable-identities; # identities that are cached in the localcache manifest gather for |self!gather-dists -> $dist { for @searchable-identities.grep({ $dist.contains-spec(%specs{$_}, :$strict) }) -> $wanted-as { take Candidate.new( dist => $dist, uri => $dist.IO.absolute, as => $wanted-as, from => self.id, ); } } } # After the `fetch` phase an app can call `.store` on any Repository that # provides it, allowing each Repository to do things like keep a simple list of # identities installed, keep a cache of anything installed (how its used here), etc method store(*@new --> Bool) { for @new.unique(:as(*.identity)).map(*.IO.parent.IO).unique -> $from { try copy-paths( $from, $.cache.IO.child($from.basename) ) } self!update; } method !package-list-path(--> IO::Path) { my $path = self.IO.child('MANIFEST.zef'); $path.spurt('') unless $path.e; $path; } method !slurp-package-list(--> List) { return [ ] unless self!package-list-path.e; do given self!package-list-path.open(:r) { LEAVE {.close} .lock: :shared; .slurp.lines.map({.split("\0")[1]}).cache; } } method !spurt-package-list($content --> Bool) { do given self!package-list-path.open(:w) { LEAVE {.close} .lock; try .spurt($content); } } # Abstraction to handle automatic updating of package list and/or local index method !gather-dists(--> List) { once { self.update } if $.auto-update || !self!package-list-path.e; return @!dists if +@!dists; @!dists = gather for self!slurp-package-list.grep(*.IO.e) -> $path { take($_) with try Zef::Distribution::Local.new($path); } } } zef-0.8.2/lib/Zef/Service/000077500000000000000000000000001355757230100152075ustar00rootroot00000000000000zef-0.8.2/lib/Zef/Service/FetchPath.pm6000066400000000000000000000022231355757230100175000ustar00rootroot00000000000000use Zef; use Zef::Utils::FileSystem; use Zef::Utils::URI; class Zef::Service::FetchPath does Fetcher does Messenger does Extractor { # .is-absolute lets the app pass around absolute paths on windows and still work as expected method fetch-matcher($uri) { $ = (?$uri.IO.is-absolute || ?$uri.lc.starts-with('.' | '/')) && $uri.IO.e } method extract-matcher($uri) { $ = (?$uri.IO.is-absolute || ?$uri.lc.starts-with('.' | '/')) && $uri.IO.d } method probe { True } method fetch($from, $to) { return False if !$from.IO.e; return $from if $from.IO.absolute eq $to.IO.absolute; # fakes a fetch my $dest-path = $from.IO.d ?? $to.IO.child("{$from.IO.basename}_{time}") !! $to; mkdir($dest-path) if $from.IO.d && !$to.IO.e; return $dest-path if copy-paths($from, $dest-path).elems; False; } method extract($path, $save-as) { my $extracted-to = $save-as.IO.child($path.IO.basename).absolute; my @extracted = copy-paths($path, $extracted-to); +@extracted ?? $extracted-to !! False; } method ls-files($path) { $ = list-paths($path, :f, :!d, :r); } } zef-0.8.2/lib/Zef/Service/InstallPM6.pm6000066400000000000000000000003731355757230100175670ustar00rootroot00000000000000use Zef; class Zef::Service::InstallPM6 does Installer does Messenger { method install-matcher($dist) { $dist ~~ Distribution } method probe { True } method install($dist, :$cur, :$force) { $cur.install($dist, :$force); } } zef-0.8.2/lib/Zef/Service/P6CReporter.pm6000066400000000000000000000062161355757230100177530ustar00rootroot00000000000000use v6; use Zef; class Zef::Service::P6CReporter does Messenger does Reporter { method report($event) { # TODO: put this into the plugin architecture state $probe = (try require Net::HTTP::POST) !~~ Nil ?? True !! False; once { say "!!!> Install Net::HTTP to enable p6c test reporting" unless $probe } if $probe { my $candi := $event.; my $report-json = to-json({ :name($candi.dist.name), :version(first *.defined, $candi.dist.meta), :dependencies($candi.dist.meta), :metainfo($candi.dist.meta.hash), :build-output($candi.^find_method('build-results') ?? $candi.build-results.Str !! Str), :build-passed($candi.^find_method('build-results') ?? $candi.build-results.map(*.so).all.so !! True), :test-output($candi.^find_method('test-results') ?? $candi.test-results.Str !! Str), :test-passed($candi.^find_method('test-results') ?? $candi.test-results.map(*.so).all.so !! True), :distro({ :name($*DISTRO.name), :version($*DISTRO.version.Str), :auth($*DISTRO.auth), :release($*DISTRO.release), }), :kernel({ :name($*KERNEL.name), :version($*KERNEL.version.Str), :auth($*KERNEL.auth), :release($*KERNEL.release), :hardware($*KERNEL.hardware), :arch($*KERNEL.arch), :bits($*KERNEL.bits), }), :perl({ :name($*PERL.name), :version($*PERL.version.Str), :auth($*PERL.auth), :compiler({ :name($*PERL.compiler.name), :version($*PERL.compiler.version.Str), :auth($*PERL.compiler.auth), :release($*PERL.compiler.release), :build-date($*PERL.compiler.build-date.Str), :codename($*PERL.compiler.codename), }), }), :vm({ :name($*VM.name), :version($*VM.version.Str), :auth($*VM.auth), :config($*VM.config), :properties($*VM.?properties), :precomp-ext($*VM.precomp-ext), :precomp-target($*VM.precomp-target), :prefix($*VM.prefix.Str), }), }); my $response = ::('Net::HTTP::POST')("http://testers.perl6.org/report", body => $report-json.encode); my $test-id = try { $response.content(:force).Int }; $test-id ?? $.stdout.emit("Report for {$candi.dist.identity} will be available at http://testers.p6c.org/reports/{$test-id}.html") !! $.stderr.emit("Encountered problems sending test report for {$event.dist.identity}"); return $test-id; } } } zef-0.8.2/lib/Zef/Service/Shell/000077500000000000000000000000001355757230100162565ustar00rootroot00000000000000zef-0.8.2/lib/Zef/Service/Shell/DistributionBuilder.pm6000066400000000000000000000025211355757230100226700ustar00rootroot00000000000000use Zef; class Zef::Service::Shell::DistributionBuilder does Builder does Messenger { method build-matcher($dist) { so $dist.builder } method probe { True } method build($dist, :@includes) { die "path does not exist: {$dist.path}" unless $dist.path.IO.e; # todo: remove this ( and corresponding code in Zef::Distribution.build-depends-specs ) in the near future my $dist-builder-compat = "$dist.builder()" eq 'MakeFromJSON' ?? "Distribution::Builder::MakeFromJSON" !! "$dist.builder()"; my $cmd = "exit((require ::(q|$dist-builder-compat|)).new(" ~ ':meta(EVAL($*IN.slurp(:close)))' ~ ").build(q|$dist.path()|)" ~ '??0!!1)'; my @exec = |($*EXECUTABLE.absolute, |@includes.grep(*.defined).map({ "-I{$_}" }), '-MMONKEY-SEE-NO-EVAL', '-e', "$cmd"); $.stdout.emit("Command: {@exec.join(' ')}"); my $ENV := %*ENV; my $passed; react { my $proc = zrun-async(@exec, :w); whenever $proc.stdout.lines { $.stdout.emit($_) } whenever $proc.stderr.lines { $.stderr.emit($_) } whenever $proc.start(:$ENV, :cwd($dist.path)) { $passed = $_.so } whenever $proc.print($dist.meta.hash.perl) { $proc.close-stdin } } return $passed; } } zef-0.8.2/lib/Zef/Service/Shell/LegacyBuild.pm6000066400000000000000000000025771355757230100211010ustar00rootroot00000000000000use Zef; class Zef::Service::Shell::LegacyBuild does Builder does Messenger { method !guess-build-file(IO() $prefix) { .map({ $prefix.child($_) }).first({ $_.e }) } method build-matcher($dist) { so self!guess-build-file($dist.path) } method probe { True } # todo: write a real hooking implementation to CU::R::I # this is a giant ball of shit btw, but required for # all the existing distributions using Build.pm method build($dist, :@includes) { die "path does not exist: {$dist.path}" unless $dist.path.IO.e; # make sure to use -Ilib instead of -I. or else Linenoise's Build.pm will trigger a strange precomp error my $build-file = self!guess-build-file($dist.path).absolute; my $cmd = "require '$build-file'; ::('Build').new.build('$dist.path.IO.absolute()') ?? exit(0) !! exit(1);"; my @exec = |($*EXECUTABLE.absolute, |@includes.grep(*.defined).map({ "-I{$_}" }), '-e', "$cmd"); $.stdout.emit("Command: {@exec.join(' ')}"); my $ENV := %*ENV; my $passed; react { my $proc = zrun-async(@exec); whenever $proc.stdout.lines { $.stdout.emit($_) } whenever $proc.stderr.lines { $.stderr.emit($_) } whenever $proc.start(:$ENV, :cwd($dist.path)) { $passed = $_.so } } return $passed; } } zef-0.8.2/lib/Zef/Service/Shell/PowerShell.pm6000066400000000000000000000004551355757230100207720ustar00rootroot00000000000000use Zef; class Zef::Service::Shell::PowerShell does Probeable { has @.ps-invocation = 'powershell', '-NoProfile', '-ExecutionPolicy', 'unrestricted', '-Command'; method probe { state $probe = !$*DISTRO.is-win ?? False !! try { zrun('powershell', '-help', :!out, :!err).so }; } } zef-0.8.2/lib/Zef/Service/Shell/PowerShell/000077500000000000000000000000001355757230100203425ustar00rootroot00000000000000zef-0.8.2/lib/Zef/Service/Shell/PowerShell/download.pm6000066400000000000000000000017361355757230100226040ustar00rootroot00000000000000use Zef; use Zef::Service::Shell::PowerShell; class Zef::Service::Shell::PowerShell::download is Zef::Service::Shell::PowerShell does Fetcher does Messenger { method fetch-matcher($url) { $ = $url.lc.starts-with('http://' | 'https://') } method probe { nextsame } method fetch($url, IO() $save-as) { die "target download directory {$save-as.parent} does not exist and could not be created" unless $save-as.parent.d || mkdir($save-as.parent); my $passed; react { my $cwd := $save-as.IO.parent; my $ENV := %*ENV; my $script := %?RESOURCES.IO.absolute; my $proc = zrun-async(|@.ps-invocation, $script, $url, '"' ~ $save-as.absolute ~ '"'); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } ($passed && $save-as.IO.e) ?? $save-as !! False; } } zef-0.8.2/lib/Zef/Service/Shell/PowerShell/unzip.pm6000066400000000000000000000036001355757230100221320ustar00rootroot00000000000000use Zef; use Zef::Service::Shell::PowerShell; class Zef::Service::Shell::PowerShell::unzip is Zef::Service::Shell::PowerShell does Extractor does Messenger { method extract-matcher($path) { so $path.IO.extension.lc eq 'zip' } method probe { nextsame } method extract(IO() $archive-file, IO() $extract-to) { die "archive file does not exist: {$archive-file.absolute}" unless $archive-file.e && $archive-file.f; die "target extraction directory {$extract-to.absolute} does not exist and could not be created" unless ($extract-to.e && $extract-to.d) || mkdir($extract-to); my $passed; react { my $cwd := $archive-file.IO.parent; my $ENV := %*ENV; my $script := %?RESOURCES.IO.absolute; my $proc = zrun-async(|@.ps-invocation, $script, $archive-file.basename, '"' ~ $extract-to.absolute ~ '"'); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } $passed ?? $extract-to !! False; } method ls-files(IO() $archive-file) { die "archive file does not exist: {$archive-file.absolute}" unless $archive-file.e && $archive-file.f; my $passed; my $output = Buf.new; react { my $cwd := $archive-file.parent; my $ENV := %*ENV; my $script := %?RESOURCES.IO.absolute; my $proc = zrun-async(|@.ps-invocation, $script, $archive-file.basename); whenever $proc.stdout(:bin) { $output.append($_) } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } my @extracted-paths = $output.decode.lines; $passed ?? @extracted-paths.grep(*.defined) !! (); } } zef-0.8.2/lib/Zef/Service/Shell/Test.pm6000066400000000000000000000027771355757230100176360ustar00rootroot00000000000000use Zef; use Zef::Utils::FileSystem; class Zef::Service::Shell::Test does Tester does Messenger { method test-matcher($path) { True } method probe { True } method test(IO() $path, :@includes) { die "path does not exist: {$path}" unless $path.IO.e; my $test-path = $path.child('t'); return True unless $test-path.e; my @test-files = grep *.extension eq any('rakutest', 't', 't6'), list-paths($test-path.absolute, :f, :!d, :r).sort; return True unless +@test-files; my @results = @test-files.map: -> $test-file { # many tests are written with the assumption that $*CWD will be their distro's base directory # so we have to hack around it so people can still (rightfully) pass absolute paths to `.test` my $relpath = $test-file.relative($path); my %ENV = %*ENV; my @cur-p6lib = %ENV.?chars ?? %ENV.split($*DISTRO.cur-sep) !! (); my @new-p6lib = $path.absolute, |@includes; %ENV = (|@new-p6lib, |@cur-p6lib).join($*DISTRO.cur-sep); my $passed; react { my $proc = zrun-async($*EXECUTABLE.absolute, $relpath); whenever $proc.stdout.lines { $.stdout.emit($_) } whenever $proc.stderr.lines { $.stderr.emit($_) } whenever $proc.start(:%ENV, :cwd($path)) { $passed = $_.so } } $passed; } return @results.all.so } } zef-0.8.2/lib/Zef/Service/Shell/curl.pm6000066400000000000000000000016331355757230100176520ustar00rootroot00000000000000use Zef; class Zef::Service::Shell::curl does Fetcher does Probeable does Messenger { method fetch-matcher($url) { $ = $url.lc.starts-with('http://' | 'https://') } method probe { state $probe = try { zrun('curl', '--help', :!out, :!err).so }; } method fetch($url, IO() $save-as) { die "target download directory {$save-as.parent} does not exist and could not be created" unless $save-as.parent.d || mkdir($save-as.parent); my $passed; react { my $cwd := $save-as.parent; my $ENV := %*ENV; my $proc = zrun-async('curl', '--silent', '-L', '-z', $save-as.absolute, '-o', $save-as.absolute, $url); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } ($passed && $save-as.e) ?? $save-as !! False; } } zef-0.8.2/lib/Zef/Service/Shell/git.pm6000066400000000000000000000125571355757230100174770ustar00rootroot00000000000000use Zef; use Zef::Utils::URI; class Zef::Service::Shell::git does Probeable does Messenger { has $.scheme; method probe { state $probe = try { run('git', '--help', :!out, :!err).so }; } method fetch-matcher($orig-url) { my $url = self!repo-url($orig-url); return $url.starts-with('git' | 'http' | 'ssh') && $url.ends-with('.git'); } method extract-matcher($str) { return False unless $str.IO.d; my $proc = zrun('git', 'status', :!out, :!err, :cwd($str)); $proc.so; } method fetch($url, IO() $save-as) { return self!clone(self!repo-url($url), $save-as) || self!pull($save-as); } method extract(IO() $repo-path, IO() $extract-to) { die "target repo directory {$repo-path.absolute} does not contain a .git/ folder" unless $repo-path.child('.git').d; my $sha1 = self!rev-parse(self!fetch($repo-path)).head; die "target repo directory {$repo-path.absolute} failed to locate checkout revision" unless $sha1; my $checkout-to = $extract-to.child($sha1); die "target repo directory {$extract-to.absolute} does not exist and could not be created" unless ($checkout-to.e && $checkout-to.d) || mkdir($checkout-to); return self!checkout($repo-path, $checkout-to, $sha1); } method ls-files(IO() $repo-path) { die "target repo directory {$repo-path.absolute} does not contain a .git/ folder" unless $repo-path.child('.git').d; my $passed; my $output = Buf.new; react { my $cwd := $repo-path.absolute; my $ENV := %*ENV; my $proc = zrun-async('git', 'ls-tree', '-r', '--name-only', self!checkout-name($repo-path)); whenever $proc.stdout(:bin) { $output.append($_) } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } my @extracted-paths = $output.decode.lines; $passed ?? @extracted-paths.grep(*.defined) !! (); } method !clone($url, IO() $save-as) { die "target download directory {$save-as.absolute} does not exist and could not be created" unless $save-as.d || mkdir($save-as); my $passed; react { my $cwd := $save-as.parent; my $ENV := %*ENV; my $proc = zrun-async('git', 'clone', $url, $save-as.basename, '--quiet'); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } ($passed && $save-as.child('.git').d) ?? $save-as !! False; } method !pull(IO() $repo-path) { die "target download directory {$repo-path.absolute} does not contain a .git/ folder" unless $repo-path.child('.git').d; my $passed; react { my $cwd := $repo-path.absolute; my $ENV := %*ENV; my $proc = zrun-async('git', 'pull', '--quiet'); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } $passed ?? $repo-path !! False; } method !fetch(IO() $repo-path) { die "target download directory {$repo-path.absolute} does not contain a .git/ folder" unless $repo-path.child('.git').d; my $passed; react { my $cwd := $repo-path.absolute; my $ENV := %*ENV; my $proc = zrun-async('git', 'fetch', '--quiet'); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } $passed ?? $repo-path !! False; } method !checkout(IO() $repo-path, IO() $extract-to, $target) { my $passed; react { my $cwd := $repo-path.absolute; my $ENV := %*ENV; my $proc = zrun-async('git', '--work-tree', $extract-to, 'checkout', $target, '.'); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } $passed ?? $extract-to !! False; } method !rev-parse(IO() $save-as) { die "target repo directory {$save-as.absolute} does not contain a .git/ folder" unless $save-as.child('.git').d; my $passed; my $output = Buf.new; react { my $cwd := $save-as.absolute; my $ENV := %*ENV; my $proc = zrun-async('git', 'rev-parse', self!checkout-name($save-as)); whenever $proc.stdout(:bin) { $output.append($_) } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } my @extracted-refs = $output.decode.lines; $passed ?? @extracted-refs.grep(*.defined) !! (); } method !repo-url($url) { my $uri = uri($!scheme ?? $url.subst(/^\w+ '://'/, "{$!scheme}://") !! $url) || return False; #' ($uri.scheme // '') ~ '://' ~ ($uri.host // '') ~ ($uri.path // '').subst(/\@.*[\/|\@|\?|\#]?$/, ''); } method !checkout-name($url) { my $uri = uri($url) || return False; my $checkout = ($uri.path // '').match(/\@(.*)[\/|\@|\?|\#]?/)[0]; return $checkout ?? $checkout.Str !! 'HEAD'; } } zef-0.8.2/lib/Zef/Service/Shell/p5tar.pm6000066400000000000000000000036541355757230100177450ustar00rootroot00000000000000use Zef; # covers untar for some windows users until a better solution is found class Zef::Service::Shell::p5tar does Extractor does Messenger { method extract-matcher($path) { so $path.lc.ends-with('.tar.gz' | '.tgz') } method probe { state $probe = try { zrun('perl', %?RESOURCES.IO.absolute, '--help', :!out, :!err) }; } method extract(IO() $archive-file, IO() $extract-to) { die "archive file does not exist: {$archive-file.absolute}" unless $archive-file.e && $archive-file.f; die "target extraction directory {$extract-to.absolute} does not exist and could not be created" unless ($extract-to.e && $extract-to.d) || mkdir($extract-to); my $passed; react { my $cwd := $extract-to; my $ENV := %*ENV; my $script := %?RESOURCES.IO.absolute; my $proc = zrun-async('perl', $script, $archive-file.absolute); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } $passed ?? $extract-to !! False; } method ls-files(IO() $archive-file) { die "archive file does not exist: {$archive-file.absolute}" unless $archive-file.e && $archive-file.f; my $passed; my $output = Buf.new; react { my $cwd := $archive-file.parent; my $ENV := %*ENV; my $script := %?RESOURCES.IO.absolute; my $proc = zrun-async('perl', $script, '--list', $archive-file.absolute); whenever $proc.stdout(:bin) { $output.append($_) } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } my @extracted-paths = $output.decode.lines; $passed ?? @extracted-paths.grep(*.defined) !! (); } } zef-0.8.2/lib/Zef/Service/Shell/prove.pm6000066400000000000000000000032031355757230100200330ustar00rootroot00000000000000use Zef; class Zef::Service::Shell::prove does Tester does Messenger { method test-matcher($path) { True } method probe { state $probe; once { # `prove --help` has exitcode == 1 unlike most other processes # so it requires a more convoluted probe check try { my $proc = zrun('prove', '--help', :out, :!err); my @out = $proc.out.lines; $proc.out.close; CATCH { when X::Proc::Unsuccessful { $probe = True if $proc.exitcode == 1 && @out.first(*.contains("-exec" | "Mac OS X")); } default { return False } } } } ?$probe; } method test(IO() $path, :@includes) { die "cannot test path that does not exist: {$path}" unless $path.e; my $test-path = $path.child('t'); return True unless $test-path.e; my %ENV = %*ENV; my @cur-p6lib = %ENV.?chars ?? %ENV.split($*DISTRO.cur-sep) !! (); my @new-p6lib = $path.absolute, |@includes; %ENV = (|@new-p6lib, |@cur-p6lib).join($*DISTRO.cur-sep); my $passed; react { my $proc = zrun-async('prove', '--ext', '.rakutest', '--ext', '.t', '--ext', '.t6', '-r', '-e', $*EXECUTABLE.absolute, $test-path.relative($path)); whenever $proc.stdout.lines { $.stdout.emit($_) } whenever $proc.stderr.lines { $.stderr.emit($_) } whenever $proc.start(:%ENV, :cwd($path)) { $passed = $_.so } } return $passed; } } zef-0.8.2/lib/Zef/Service/Shell/tar.pm6000066400000000000000000000037261355757230100175000ustar00rootroot00000000000000use Zef; # XXX: when passing command line arguments to tar in this module be sure to use # relative paths. ex: set :cwd to $tar-file.parent, and use $tar-file.basename as the target # This is because gnu tar on windows can't handle a windows style volume in path arguments class Zef::Service::Shell::tar does Extractor does Messenger { method extract-matcher($path) { so $path.lc.ends-with('.tar.gz' | '.tgz') } method probe { state $probe = try { zrun('tar', '--help', :!out, :!err).so }; } method extract(IO() $archive-file, IO() $extract-to) { die "archive file does not exist: {$archive-file.absolute}" unless $archive-file.e && $archive-file.f; die "target extraction directory {$extract-to.absolute} does not exist and could not be created" unless ($extract-to.e && $extract-to.d) || mkdir($extract-to); my $passed; react { my $cwd := $archive-file.parent; my $ENV := %*ENV; my $proc = zrun-async('tar', '-zxvf', $archive-file.basename, '-C', $extract-to.relative($cwd)); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } $passed ?? $extract-to !! False; } method ls-files(IO() $archive-file) { die "archive file does not exist: {$archive-file.absolute}" unless $archive-file.e && $archive-file.f; my $passed; my $output = Buf.new; react { my $cwd := $archive-file.parent; my $ENV := %*ENV; my $proc = zrun-async('tar', '--list', '-f', $archive-file.basename); whenever $proc.stdout(:bin) { $output.append($_) } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } my @extracted-paths = $output.decode.lines; $passed ?? @extracted-paths.grep(*.defined) !! (); } } zef-0.8.2/lib/Zef/Service/Shell/unzip.pm6000066400000000000000000000033071355757230100200520ustar00rootroot00000000000000use Zef; class Zef::Service::Shell::unzip does Extractor does Messenger { method extract-matcher($path) { so $path.IO.extension.lc eq 'zip' } method probe { state $probe = try { zrun('unzip', '--help', :!out, :!err).so }; } method extract(IO() $archive-file, IO() $extract-to) { die "archive file does not exist: {$archive-file.absolute}" unless $archive-file.e && $archive-file.f; die "target extraction directory {$extract-to.absolute} does not exist and could not be created" unless ($extract-to.e && $extract-to.d) || mkdir($extract-to); my $passed; react { my $cwd := $archive-file.parent; my $ENV := %*ENV; my $proc = zrun-async('unzip', '-o', '-qq', $archive-file.basename, '-d', $extract-to.absolute); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } $passed ?? $extract-to !! False; } method ls-files(IO() $archive-file) { die "archive file does not exist: {$archive-file.absolute}" unless $archive-file.e && $archive-file.f; my $passed; my $output = Buf.new; react { my $cwd := $archive-file.parent; my $ENV := %*ENV; my $proc = zrun-async('unzip', '-Z', '-1', $archive-file.basename); whenever $proc.stdout(:bin) { $output.append($_) } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } my @extracted-paths = $output.decode.lines; $passed ?? @extracted-paths.grep(*.defined) !! (); } } zef-0.8.2/lib/Zef/Service/Shell/wget.pm6000066400000000000000000000016071355757230100176540ustar00rootroot00000000000000use Zef; class Zef::Service::Shell::wget does Fetcher does Probeable does Messenger { method fetch-matcher($url) { $ = $url.lc.starts-with('http://' | 'https://') } method probe { state $probe = try { zrun('wget', '--help', :!out, :!err).so }; } method fetch($url, IO() $save-as) { die "target download directory {$save-as.parent} does not exist and could not be created" unless $save-as.parent.d || mkdir($save-as.parent); my $passed; react { my $cwd := $save-as.parent; my $ENV := %*ENV; my $proc = zrun-async('wget', '-P', $cwd, '--quiet', $url, '-O', $save-as.absolute); whenever $proc.stdout(:bin) { } whenever $proc.stderr(:bin) { } whenever $proc.start(:$ENV, :$cwd) { $passed = $_.so } } ($passed && $save-as.e) ?? $save-as !! False; } } zef-0.8.2/lib/Zef/Service/TAP.pm6000066400000000000000000000036371355757230100162700ustar00rootroot00000000000000use Zef; use Zef::Utils::FileSystem; class Zef::Service::TAP does Tester does Messenger { method test-matcher($path) { True } method probe { state $probe = (try require TAP::Harness) !~~ Nil ?? True !! False } method test($path, :@includes) { die "path does not exist: {$path}" unless $path.IO.e; my $test-path = $path.IO.child('t'); return True unless $test-path.e; my @test-files = grep *.extension eq any('rakutest', 't', 't6'), list-paths($test-path.absolute, :f, :!d, :r).sort; return True unless +@test-files; my $stdout = $*OUT; my $stderr = $*ERR; my $out-supply = $.stdout; my $err-supply = $.stderr; my $out; my $err; my $cwd = $*CWD; my class OUT_CAPTURE is IO::Handle { method print(*@_) { temp $*OUT = $stdout; $out-supply.emit(.chomp) for @_; True; } method flush {} } my class ERR_CAPTURE is IO::Handle { method print(*@_) { temp $*ERR = $stderr; $err-supply.emit(.chomp) for @_; True; } method flush {} } my $result = try { require TAP; chdir($path); $*OUT = OUT_CAPTURE.new; $*ERR = ERR_CAPTURE.new; my @incdirs = $path.IO.absolute, |@includes; my @handlers = ::("TAP::Harness::SourceHandler::Perl6").new(:@incdirs); my $parser = ::("TAP::Harness").new(:@handlers); my $promise = $parser.run(@test-files>>.relative($path)); my $result = $promise.result; $result; } chdir($cwd); $out-supply.done; $err-supply.done; $*OUT = $stdout; $*ERR = $stderr; $result.failed == 0 && not $result.errors ?? True !! False; } } zef-0.8.2/lib/Zef/Test.pm6000066400000000000000000000035021355757230100151520ustar00rootroot00000000000000use Zef; class Zef::Test does Pluggable { submethod TWEAK(|) { @ = self.plugins; # preload plugins } method test-matcher($path) { self.plugins.grep(*.test-matcher($path)) } method test($candi, :@includes, Supplier :$logger, Int :$timeout) { my $path := $candi.dist.path; die "Can't test non-existent path: {$path}" unless $path.IO.e; my $testers := self.test-matcher($path).cache; unless +$testers { my @report_enabled = self.plugins.map(*.short-name); my @report_disabled = self.backends.map(*.).grep({ $_ ~~ none(@report_enabled) }); die "Enabled testing backends [{@report_enabled}] don't understand $path\n" ~ "You may need to configure one of the following backends, or install its underlying software - [{@report_disabled}]"; } my $tester = $testers.head; if ?$logger { $logger.emit({ level => DEBUG, stage => TEST, phase => START, candi => $candi, message => "Testing with plugin: {$tester.^name}" }); $tester.stdout.Supply.grep(*.defined).act: -> $out is copy { $logger.emit({ level => VERBOSE, stage => TEST, phase => LIVE, candi => $candi, message => $out }) } $tester.stderr.Supply.grep(*.defined).act: -> $err is copy { $logger.emit({ level => ERROR, stage => TEST, phase => LIVE, candi => $candi, message => $err }) } } my $todo = start { try $tester.test($path, :@includes) }; my $time-up = ($timeout ?? Promise.in($timeout) !! Promise.new); await Promise.anyof: $todo, $time-up; $logger.emit({ level => DEBUG, stage => TEST, phase => LIVE, message => "Testing $path timed out" }) if ?$logger && $time-up.so && $todo.not; my @got = $todo.so ?? $todo.result !! False; @got; } } zef-0.8.2/lib/Zef/Utils/000077500000000000000000000000001355757230100147075ustar00rootroot00000000000000zef-0.8.2/lib/Zef/Utils/FileSystem.pm6000066400000000000000000000052221355757230100174200ustar00rootroot00000000000000unit module Zef::Utils::FileSystem; sub list-paths(IO() $path!, Bool :$d, Bool :$f = True, Bool :$r = True, Bool :$dot) is export { die "{$path} does not exists" unless $path.e; my &wanted-paths := -> @_ { grep { .basename.starts-with('.') && !$dot ?? 0 !! 1 }, @_ } gather { my @stack = $path.f ?? $path !! dir($path); while @stack.splice -> @paths { for wanted-paths(@paths) -> IO() $current { take $current if ($current.f && ?$f) || ($current.d && ?$d); @stack.append(dir($current)) if ?$r && $current.d; } } } } sub copy-paths(IO() $from-path!, IO() $to-path, Bool :$d, Bool :$f = True, Bool :$r = True, Bool :$dot) is export { die "{$from-path} does not exists" unless $from-path.IO.e; mkdir($to-path) unless $to-path.e; eager gather for list-paths($from-path, :$d, :$f, :$r, :$dot).sort -> $from-file { my $from-relpath = $from-file.relative($from-path); my $to-file = IO::Path.new($from-relpath, :CWD($to-path)); mkdir($to-file.parent) unless $to-file.e; next if $from-file eq $to-file; # copy deadlocks on older rakudos otherwise take $to-file if copy($from-file, $to-file); } } sub move-paths(IO() $from-path, IO() $to-path, Bool :$d = True, Bool :$f = True, Bool :$r = True, Bool :$dot) is export { my @copied = copy-paths($from-path, $to-path, :$d, :$f, :$r, :$dot); my @deleted = delete-paths($from-path, :$d, :$f, :$r, :$dot); @copied; } sub delete-paths(IO() $path, Bool :$d = True, Bool :$f = True, Bool :$r = True, Bool :$dot = True) is export { my @paths = list-paths($path, :$d, :$f, :$r, :$dot).unique(:as(*.absolute)); my @files = @paths.grep(*.f); my @dirs = @paths.grep(*.d); $path.f ?? @files.push($path.IO) !! @dirs.push($path.IO); eager gather { for @files.sort(*.chars).reverse { take $_ if try unlink($_) } for @dirs\.sort(*.chars).reverse { take $_ if try rmdir($_) } } } sub lock-file-protect($path, &code, Bool :$shared = False) is export { do given ($shared ?? $path.IO.open(:r) !! $path.IO.open(:w)) { LEAVE {.close} LEAVE {try .path.unlink} .lock(:$shared); code(); } } our sub which($name) { my $source-paths := $*SPEC.path.grep(*.?chars).map(*.IO).grep(*.d); my $path-guesses := $source-paths.map({ $_.child($name) }); my $possibilities := $path-guesses.map: -> $path { ((BEGIN $*DISTRO.is-win) ?? ($path.absolute, %*ENV.split(';').map({ $path.absolute ~ $_ }).Slip) !! $path.absolute).Slip } return $possibilities.grep(*.defined).grep(*.IO.f); } zef-0.8.2/lib/Zef/Utils/SystemInfo.pm6000066400000000000000000000027361355757230100174430ustar00rootroot00000000000000unit module Zef::Utils::SystemInfo; # the extra signal stuff is because JVM does not have a `signal` symbol our sub signal-ignore($) { Supply.new } our $signal-handler := &::("signal") ~~ Failure ?? &::("signal-ignore") !! &::("signal"); our $sig-resize := ::("Signal::SIGWINCH"); try $signal-handler.($sig-resize).act: { $ = GET-TERM-COLUMNS() } # Get terminal width sub GET-TERM-COLUMNS is export { state $default-only; return $default-only if $default-only; if $*DISTRO.is-win { # Windowsy my $default = 80 - 1; try { my $proc = shell("mode", :out, :!err, :enc('latin-1')); my $output = $proc.slurp(:close) if $ = $proc.so; return $default unless $output; if $output ~~ /'CON:' \n <.ws> '-'+ \n .*? \n \N+? $=[<.digit>+]/ { my $cols = $/.comb(/\d/).join; my $got_cols = (+$cols - 1) if $cols.chars; return ($default-only = ($got_cols ?? max($default, $got_cols) !! $default)); } } return $default; } else { # Linuxy my $default = 120 - 1; try { my $proc = run('tput', 'cols', :out, :!err, :enc('latin-1')); my $cols = $proc.out.slurp(:close).lines.head if $ = $proc.so; my $got_cols = (+$cols - 1) if $cols.chars; return ($default-only = ($got_cols ?? max($default, $got_cols) !! $default)); } return $default; } } zef-0.8.2/lib/Zef/Utils/SystemQuery.pm6000066400000000000000000000046151355757230100176530ustar00rootroot00000000000000unit module Zef::Utils::SystemQuery; our sub system-collapse($data) is export { return $data unless $data ~~ Hash|Array; my sub walk(@path, $idx, $query-source) { die "Attempting to find \$*{@path[0].uc}.{@path[1..*].join('.')}" if !$query-source.^can("{@path[$idx]}") && $idx < @path.elems; return $query-source."{@path[$idx]}"() if $idx+1 == @path.elems; return walk(@path, $idx+1, $query-source."{@path[$idx]}"()); } my $return = $data.WHAT.new; for $data.keys -> $idx { given $idx { when /^'by-env-exists'/ { my $key = $idx.split('.')[1]; my $value = %*ENV{$key}:exists ?? 'yes' !! 'no'; die "Unable to resolve path: {$idx} in \%*ENV\nhad: {$value}" unless $data{$idx}{$value}:exists; return system-collapse($data{$idx}{$value}); } when /^'by-env'/ { my $key = $idx.split('.')[1]; my $value = %*ENV{$key}; die "Unable to resolve path: {$idx} in \%*ENV\nhad: {$value // ''}" unless defined($value) && ($data{$idx}{$value}:exists); return system-collapse($data{$idx}{$value}); } when /^'by-' (distro|kernel|perl|vm)/ { my $query-source = do given $/[0] { when 'distro' { $*DISTRO } when 'kernel' { $*KERNEL } when 'perl' { $*PERL } when 'vm' { $*VM } } my $path = $idx.split('.'); my $value = walk($path, 1, $query-source); my $fkey = ($data{$idx}{$value}:exists) ?? $value !! ($data{$idx}{''}:exists) ?? '' !! Any; die "Unable to resolve path: {$path.cache[*-1].join('.')} in \$*DISTRO\nhad: {$value} ~~ {$value.WHAT.^name}" if Any ~~ $fkey; return system-collapse($data{$idx}{$fkey}); } default { my $val = system-collapse($data ~~ Array ?? $data[$idx] !! $data{$idx}); $return{$idx} = $val if $return ~~ Hash; $return.push($val) if $return ~~ Array; } }; } return $return; } zef-0.8.2/lib/Zef/Utils/URI.pm6000066400000000000000000000200401355757230100157660ustar00rootroot00000000000000class Zef::Utils::URI { has $.is-relative; has $.match; has $.scheme; has $.host; has $.port; has $.user-info; has $.path; has $.query; has $.fragment; method CALL-ME($id) { try self.new($id) } my grammar URI { token URI-reference { || } token URI { ':' ['?' ]? ['#' ]? } token relative-ref { ['?' ]? ['#' ]? } token heir-part { || '//' || || || } token relative-part { || '//' || || || } token scheme { <.alpha> [ || <.alpha> || <.digit> || '+' || '-' || '.' ]* } token authority { [ '@']? [':' ]? } token userinfo { [<.unreserved> || <.pct-encoded> || <.sub-delims> || ':']* } token host { <.IP-literal> || <.IPv4address> || <.reg-name> } token IP-literal { '[' [<.IPv6address> || <.IPv6addrz> || <.IPvFuture>] ']' } token IPv6addz { <.IPv6address> '%25' <.ZoneID> } token ZoneID { [<.unreserved> || <.pct-encoded>]+ } token IPvFuture { 'v' <.xdigit>+ '.' [<.unreserved> || <.sub-delims> || ':']+ } token IPv6address { || [<.h16> ':'] ** 6 <.ls32> || '::' [<.h16> ':'] ** 5 <.ls32> || [ <.h16> ]? '::' [<.h16> ':'] ** 4 <.ls32> || [[<.h16> ':'] ** 0..1 <.h16> ]? '::' [<.h16> ':'] ** 3 <.ls32> || [[<.h16> ':'] ** 0..2 <.h16> ]? '::' [<.h16> ':'] ** 2 <.ls32> || [[<.h16> ':'] ** 0..3 <.h16> ]? '::' <.h16> ':' <.ls32> || [[<.h16> ':'] ** 0..4 <.h16> ]? '::' <.ls32> || [[<.h16> ':'] ** 0..5 <.h16> ]? '::' <.h16> || [[<.h16> ':'] ** 0..6 <.h16> ]? '::' } token h16 { <.xdigit> ** 1..4 } token ls32 { [<.h16> ':' <.h16>] || <.IPv4address> } token IPv4address { <.dec-octet> '.' <.dec-octet> '.' <.dec-octet> '.' <.decoctet> } token dec-octet { || <.digit> || [\x[31]..\x[39]] <.digit> || '1' <.digit> ** 2 || '2' [\x[30]..\x[34]] <.digit> || '25' [\x[30]..\x[35]] } token reg-name { [<.unreserved> || <.pct-encoded> || <.sub-delims>]* } token port { <.digit>* } token path { || <.path-abempty> || <.path-absolute> || <.path-noscheme> || <.path-rootless> || <.path-empty> } token path-abempty { ['/' <.segment>]* } token path-absolute { '/' [<.segment-nz> ['/' <.segment>]*]? } token path-noscheme { <.segment-nz-nc> ['/' <.segment>]* } token path-rootless { <.segment-nz> ['/' <.segment>]* } token path-empty { <.pchar> ** 0 } token segment { <.pchar>* } token segment-nz { <.pchar>+ } token segment-nz-nc { [<.unreserved> || <.pct-encoded> || <.sub-delims>]+ } token pchar { <.unreserved> || <.pct-encoded> || <.sub-delims> || ':' || '@' } token query { [<.pchar> || '/' || '?']* } token fragment { [<.pchar> || '/' || '?']* } token pct-encoded { '%' <.xdigit> <.xdigit> } token unreserved { <.alpha> || <.digit> || < - . _ ~ > } token reserved { <.gen-delims> || <.sub-delims> } token gen-delims { < : / ? # [ ] @ > } token sub-delims { < ! $ & ' ( ) * + , ; = > } # ' <- fixes syntax highlighting } my grammar URI::File is URI { token TOP { } token file-URI { ":" [ "?" ]? } token scheme { "file" } token heir-part { "//"? || } token auth-path { [ ]? || || } token auth { [ "@" ]? } token local-path { || } token unc-path { "//" "/"? } token windows-path { } token drive-letter { [ ]? } token drive-marker { ":" || "|" } # XXX: this is a bit of a hack -- see: # https://github.com/ugexe/zef/issues/204#issuecomment-366957374 token pchar { <.unreserved> || <.pct-encoded> || <.sub-delims> || ':' || '@' || ' ' } } method new($id is copy) { # prefix windows paths with `file://` so they get parsed as a 'uri' type identity. my $possible-file-uri = "{$id.starts-with('file://')??''!!'file://'}{$*DISTRO.is-win??$id.subst('\\','/',:g)!!$id}"; if URI::File.parse($possible-file-uri, :rule) -> $m { my $ap = $m.; my $volume = ~($ap.. // ''); # what IO::SPEC::Win32 understands my $path = ~($ap.. // $ap. // die "Could not parse path from: $id"); my $host = ~($ap. // ''); my $scheme = ~$m.; my $is-relative = $path.IO.is-relative || not $ap...defined; # because `|` is sometimes used as a windows volume separator in a file-URI my $normalized-path = $is-relative ?? $path !! $*SPEC.join($volume, $path, ''); self.bless( :match($m), :$is-relative, :$scheme, :$host, :path($normalized-path) ); } elsif URI.parse($id, :rule) -> $m { my $heir = $m.; my $auth = $heir.; self.bless( match => $m, is-relative => False, scheme => ~($m. // '').lc, host => ~($auth. // ''), port => ($auth. // Int).Int, user-info => ~($auth. // ''), path => ~($heir. // '/'), query => ~($m. // ''), fragment => ~($m. // ''), ); } elsif URI.parse($id, :rule) -> $m { self.bless( match => $m, is-relative => True, scheme => ~($m. // '').lc, path => ~($m. || '/'), query => ~($m. // ''), fragment => ~($m. // ''), ); } elsif $id ~~ /^(.+?) '@' (.+?) ':' (.*)/ and URI.parse("ssh\:\/\/$0\@$1\/$2", :rule) -> $m { my $heir = $m.; my $auth = $heir.; self.bless( match => $m, is-relative => False, scheme => ~($m. // '').lc, host => ~($auth. // ''), port => ($auth. // Int).Int, user-info => ~($auth. // ''), path => ~($heir. // '/'), query => ~($m. // ''), fragment => ~($m. // ''), ); } else { die "Cannot parse $id as an URI"; } } } sub uri($str) is export { Zef::Utils::URI($str) } zef-0.8.2/logotype/000077500000000000000000000000001355757230100141575ustar00rootroot00000000000000zef-0.8.2/logotype/logo_32x32.png000066400000000000000000000024751355757230100164760ustar00rootroot00000000000000PNG  IHDR szzsBIT|d pHYsXtEXtSoftwarewww.inkscape.org<IDATX͗KlUgfܹ^Z胖>-E۶"S#&$jxp,Xb,Q_ %@ &ւTXJ[/mz_vAdf9ߜ9uuk\iV { ̑4j!yzmERd{ Q+y quz1j%ie|o\M`.豣4kɽKJ%4~a<(:$ߴ̷Ӡ'zkd%6_ƞ`-GKS2{m;m\Zuy;~]UM a_,ḩp:1j=PFJ.fFɝqPX+ȷ^ .rҝ5j!gX X< eYtX#<,gQ1VislWo E ?#cBڬoD --list \n"; print "Extract files: \n"; exit 0; } elsif( $ARGV[0] eq '--list' ) { my $extractor = Archive::Tar->new(); $extractor->read($ARGV[1]); print "$_\n" for( $extractor->list_files() ); exit 0; } else { my $extractor = Archive::Tar->new(); $extractor->read($ARGV[0]); $extractor->extract(); exit 0; } zef-0.8.2/resources/scripts/win32http.ps1000066400000000000000000000005701355757230100203070ustar00rootroot00000000000000Param ( [Parameter(Mandatory=$True)] [System.Uri]$uri, [Parameter(Mandatory=$True)] [string]$FilePath, $UserAgent = "rakudo perl6/zef powershell downloader" ) [Net.ServicePointManager]::SecurityProtocol = "tls12, tls11, tls"; $client = New-Object System.Net.WebClient; $client.Headers['User-Agent'] = $UserAgent; $client.DownloadFile($uri.ToString(), $FilePath) zef-0.8.2/resources/scripts/win32unzip.ps1000066400000000000000000000013361355757230100204760ustar00rootroot00000000000000Param ( [Parameter(Mandatory=$True)] [string]$FilePath, $out = "" ) $shell = New-Object -com shell.application $FilePath = $ExecutionContext.SessionState.Path.GetUnresolvedProviderPathFromPSPath($FilePath) $items = $shell.NameSpace($FilePath).items() function List-ZipFiles { $ns = $shell.NameSpace($args[0]) foreach( $item in $ns.Items() ) { if( $item.IsFolder ) { List-ZipFiles($item) } else { $path = $item | Select -ExpandProperty Path Write-Host $path } } } if( $out -ne '' ) { $to = $shell.NameSpace($out) $to.CopyHere($items, 0x14) } else { $path = $items | Select -ExpandProperty Path Write-Host $path List-ZipFiles $path } zef-0.8.2/t/000077500000000000000000000000001355757230100125605ustar00rootroot00000000000000zef-0.8.2/t/00-load.t000066400000000000000000000027221355757230100141040ustar00rootroot00000000000000use v6; use Test; plan 2; subtest 'Core' => { use-ok("Zef"); # Just `use Zef::CLI` will make it output usage # use-ok("Zef::CLI"); use-ok("Zef::Build"); use-ok("Zef::Config"); use-ok("Zef::Extract"); use-ok("Zef::Identity"); use-ok("Zef::Test"); use-ok("Zef::Install"); use-ok("Zef::Fetch"); use-ok("Zef::Client"); use-ok("Zef::Repository"); use-ok("Zef::Repository::LocalCache"); use-ok("Zef::Repository::Ecosystems"); use-ok("Zef::Distribution"); use-ok("Zef::Distribution::DependencySpecification"); use-ok("Zef::Distribution::Local"); use-ok("Zef::Utils::FileSystem"); use-ok("Zef::Utils::SystemInfo"); use-ok("Zef::Utils::URI"); } subtest 'Plugins' => { use-ok("Zef::Service::FetchPath"); use-ok("Zef::Service::TAP"); use-ok("Zef::Service::InstallPM6"); use-ok("Zef::Service::P6CReporter"); use-ok("Zef::Service::Shell::DistributionBuilder"); use-ok("Zef::Service::Shell::LegacyBuild"); use-ok("Zef::Service::Shell::Test"); use-ok("Zef::Service::Shell::prove"); use-ok("Zef::Service::Shell::unzip"); use-ok("Zef::Service::Shell::tar"); use-ok("Zef::Service::Shell::p5tar"); use-ok("Zef::Service::Shell::curl"); use-ok("Zef::Service::Shell::git"); use-ok("Zef::Service::Shell::wget"); use-ok("Zef::Service::Shell::PowerShell"); use-ok("Zef::Service::Shell::PowerShell::download"); use-ok("Zef::Service::Shell::PowerShell::unzip"); } zef-0.8.2/t/distribution-depends-parsing.t000066400000000000000000000021361355757230100205470ustar00rootroot00000000000000use v6; use Test; plan 4; use Zef::Distribution; my $json = q:to/META6/; { "perl":"6", "name":"Test::Complex::Depends", "version":"0", "auth":"github:stranger", "description":"Test hash-based depends and native depends parsing", "license":"none", "depends": [ "Zef::Client", { "from": "native", "name": { "by-distro.name": { "macosx": "mac", "win32" : "win", "linux" : "linux", "" : "unknown" } } } ], "build-depends": [ "Zef::Build" ], "test-depends": [ "Zef::Test" ], "provides": { } } META6 my $dist = Zef::Distribution.new(|Rakudo::Internals::JSON.from-json($json)); is $dist.depends-specs[0].name, 'Zef::Client'; is $dist.depends-specs[0].from-matcher, 'Perl6'; ok $dist.depends-specs[1].name ~~ any('mac', 'win', 'linux', 'unknown'); is $dist.depends-specs[1].from-matcher, 'native'; zef-0.8.2/t/identity.t000066400000000000000000000047561355757230100146120ustar00rootroot00000000000000use v6; use Test; plan 6; use Zef::Identity; subtest { my @variations = ( "Net::HTTP:ver<1.0>:auth", "Net::HTTP:auth:ver:api<>", ); for @variations -> $identity { my $ident = Zef::Identity.new("Net::HTTP:ver<1.0>:auth"); is $ident.auth, 'github:ugexe'; is $ident.name, 'Net::HTTP'; is $ident.version, '1.0'; } }, 'Require spec - exact'; subtest { my @variations = ( "Net::HTTP:ver<*>:auth", ); for @variations -> $identity { my $ident = Zef::Identity.new("Net::HTTP:ver<*>:auth"); is $ident.auth, 'github:ugexe'; is $ident.name, 'Net::HTTP'; is $ident.version, '*'; } }, 'Require spec - range *'; subtest { my @variations = ( "Net::HTTP:ver<1.0+>:auth", "Net::HTTP:auth:ver<1.0+>:api<>", ); for @variations -> $identity { my $ident = Zef::Identity.new("Net::HTTP:ver<1.0+>:auth"); is $ident.auth, 'github:ugexe'; is $ident.name, 'Net::HTTP'; is $ident.version, '1.0+'; } }, 'Require spec - range +'; subtest { ok ?str2identity("***not valid***"); subtest { my $expected = "Net::HTTP:ver<1.0+>:auth"; my $require = "Net::HTTP:ver<1.0+>:auth:api<>"; my $i-require = str2identity($require); is $i-require, $expected; }, 'exact'; subtest { my $require = "Net::HTTP"; my $i-require = str2identity($require); is $i-require, 'Net::HTTP'; }, 'not exact'; subtest { my $require = "HTTP"; my $i-require = str2identity($require); is $i-require, 'HTTP'; }, 'root namespace'; }, 'str2identity'; subtest { my $require = "Net::HTTP:ver<1.0+>:auth"; my %hash = %( :name, :ver<1.0+>, :auth ); ok ?identity2hash("***not valid***"); my %i-require = identity2hash($require); is %i-require, 'Net::HTTP'; is %i-require, '1.0+'; is %i-require, 'github:ugexe'; }, 'identity2hash'; subtest { my $require = "Net::HTTP:ver<1.0+>:auth"; my %hash = %( :name, :ver<1.0+>, :auth ); ok ?hash2identity("***not valid***"); my $i-require = hash2identity(%hash); is $i-require, "Net::HTTP:ver<1.0+>:auth"; }, 'hash2identity'; zef-0.8.2/t/utils-filesystem.t000066400000000000000000000132001355757230100162630ustar00rootroot00000000000000use v6; use Zef::Utils::FileSystem; use Test; plan 4; my $save-to = $*TMPDIR.child(time); my $dir-id = 0; # :d :f :r subtest { temp $save-to = $save-to.child(++$dir-id); my @delete-us; # 1. Folder: /{temp folder} # 2. File: /{temp folder}/base-delete.me # 3. Folder: /{temp folder}/deleteme-subfolder # 4. File: /{temp folder}/deleteme-subfolder/base-delete.me # All 4 items should get deleted mkdir($_) and @delete-us.append($_) with ~$save-to; my $sub-folder = $save-to.child('deleteme-subfolder'); mkdir($_) and @delete-us.append($_) with ~$sub-folder; # create 2 test files, one in each directory we created above my $save-to-file = $save-to.child('base-delete.me'); my $sub-folder-file = $sub-folder.child('sub-delete.me'); $save-to-file.spurt(time); $sub-folder-file.spurt(time); @delete-us.append($save-to-file.path); @delete-us.append($sub-folder-file.path); ok $save-to.d, "Folder available to delete"; my @paths = list-paths($save-to, :f, :d, :r); my @deleted = delete-paths($save-to, :f, :d, :r); my $to-be-deleted = any($save-to, $sub-folder, $save-to-file, $sub-folder-file); for @delete-us -> $path-to-delete { is $path-to-delete, any(|@paths,$save-to), 'file was found in list-paths'; is $path-to-delete, $to-be-deleted, "Deleted: {$path-to-delete.path}"; } }, "list-paths and delete-paths :d :f :r (rm -rf)"; # :d :f subtest { temp $save-to = $save-to.child(++$dir-id); my @delete-us; # 1. Folder: /{temp folder} # 2. File: /{temp folder}/base-delete.me # 3. Folder: /{temp folder}/deleteme-subfolder # 4. File: /{temp folder}/deleteme-subfolder/base-delete.me # Only item 2 should get deleted my $sub-folder = $save-to.child('deleteme-subfolder'); mkdir($sub-folder); # create 2 test files, one in each directory we created above my $save-to-file = $save-to.child('base-delete.me'); my $sub-folder-file = $sub-folder.child('sub-delete.me'); $save-to-file.spurt(time); $sub-folder-file.spurt(time); @delete-us.append($save-to-file); ok $save-to.d, "Folder available to delete"; my @paths = list-paths($save-to, :d, :f); my @deleted = delete-paths($save-to, :d, :f); my $to-be-deleted = any($save-to-file); my $not-deleted = any($save-to, $sub-folder, $sub-folder-file); for @delete-us -> $path-to-delete { is $path-to-delete, any(@paths), "File was found in list-paths"; is $path-to-delete, $to-be-deleted, "Deleted: {$path-to-delete.path}"; isnt $path-to-delete, $not-deleted, 'Did not delete sub-file or delete non-empty directory'; } }, "list-paths and delete-paths :d :f (no recursion)"; # :d :r subtest { temp $save-to = $save-to.child(++$dir-id); my @delete-us; # 1. Folder: /{temp folder} # 2. File: /{temp folder}/base-delete.me # 3. Folder: /{temp folder}/deleteme-subfolder # 4. File: /{temp folder}/deleteme-subfolder/base-delete.me # 5. Folder /{temp folder}/empty-subfolder # Only item 5 will be deleted my $sub-folder = $save-to.child('deleteme-subfolder'); mkdir($sub-folder); my $sub-folder-empty = $save-to.child('empty-subfolder'); @delete-us.append($sub-folder-empty); mkdir($sub-folder-empty); # create 2 test files, one in each directory we created above my $save-to-file = $save-to.child('base-delete.me'); my $sub-folder-file = $sub-folder.child('sub-delete.me'); $save-to-file.spurt(time); $sub-folder-file.spurt(time); ok $save-to.d, "Folder available to delete"; my @paths = list-paths($save-to, :d, :r); my @deleted = delete-paths($save-to, :d, :r); my $to-be-deleted = any($sub-folder-empty); my $not-deleted = any($save-to, $save-to-file, $sub-folder, $sub-folder-file); for @delete-us -> $path-to-delete { is $path-to-delete, any(@paths), "File was found in list-paths"; is $path-to-delete, $to-be-deleted, "Deleted: {$path-to-delete.path}"; isnt $path-to-delete, $not-deleted, 'Did not delete sub-file or delete non-empty directory'; } }, "list-paths and delete-paths :d :r"; # :f :r subtest { temp $save-to = $save-to.child(++$dir-id); my @delete-us; # 1. Folder: /{temp folder} # 2. File: /{temp folder}/base-delete.me # 3. Folder: /{temp folder}/deleteme-subfolder # 4. File: /{temp folder}/deleteme-subfolder/base-delete.me # 5. Folder /{temp folder}/empty-subfolder # Delete items 2 and 4 my $sub-folder = $save-to.child('deleteme-subfolder'); mkdir($sub-folder); my $sub-folder-empty = $save-to.child('empty-subfolder'); mkdir($sub-folder-empty); # create 2 test files, one in each directory we created above my $save-to-file = $save-to.child('base-delete.me'); my $sub-folder-file = $sub-folder.child('sub-delete.me'); $save-to-file.spurt(time); $sub-folder-file.spurt(time); @delete-us.append($save-to-file); @delete-us.append($sub-folder-file); ok $save-to.d, "Folder available to delete"; my @paths = list-paths($save-to, :f, :r); my @deleted = delete-paths($save-to, :f, :r); my $to-be-deleted = any($save-to-file, $sub-folder-file); my $not-deleted = any($save-to, $sub-folder, $sub-folder-empty); for @delete-us -> $path-to-delete { is $path-to-delete, any(@paths), "File was found in list-paths"; is $path-to-delete, $to-be-deleted, "Deleted: {$path-to-delete.path}"; isnt $path-to-delete, $not-deleted, 'Did not delete sub-file or delete non-empty directory'; } }, "list-paths and delete-paths :f :r"; try rmdir($save-to); zef-0.8.2/xt/000077500000000000000000000000001355757230100127505ustar00rootroot00000000000000zef-0.8.2/xt/install.t000066400000000000000000000074721355757230100146150ustar00rootroot00000000000000use v6; use Test; plan 3; use Zef; use Zef::Client; use Zef::Utils::FileSystem; use Zef::Identity; use Zef::Config; my $path = $*TMPDIR.child("zef").child("{time}.{$*PID}"); my $bin-dir = $path.child('bin'); my $dist-dir = $path.child('dist'); my $sources-dir = $path.child('sources'); my CompUnit::Repository @cur = CompUnit::RepositoryRegistry\ .repository-for-spec("inst#{$path.absolute}", :next-repo($*REPO)); END { try delete-paths($path, :r, :d, :f, :dot) } my $guess-path = $?FILE.IO.parent.parent.child('resources/config.json'); my $config-file = $guess-path.e ?? ~$guess-path !! Zef::Config::guess-path(); my $config = Zef::Config::parse-file($config-file); $config = "$path/.cache"; $config = "$path/.cache/store"; $config = "$path/.cache/tmp"; my @installed; # keep track of what gets installed for the optional uninstall test at the end my $client = Zef::Client.new(:$config); # Keeps every $client.install from printing to stdout sub test-install($path = $?FILE.IO.parent.parent) { # Need to remove all stdout/stderr output from Zef::Client, or at least complete # the message passing mechanism so it can be turned off at will. Until then just # turn off stdout for this test as it will output details to stdout even when !$verbose) temp $*OUT = class :: { method print(|) {}; method flush(|) {}; }; # No test distribution to install yet, so test install zef itself my $candidate = Candidate.new( dist => Zef::Distribution::Local.new($path), uri => $path.IO.absolute, as => ~$path, from => ~$?FILE, ); my @got = |$client.make-install( :to(@cur), :!test, :!fetch, $candidate ); @installed = unique(|@installed, |@got, :as(*.dist.identity)); } ######################################################################################### subtest { my @installed = test-install(); is +@installed, 1, 'Installed a single module'; is +$dist-dir.dir.grep(*.f), 1, 'A single distribution file should exist'; # $dist-info is the content of a file that holds meta information, such as # the new names of the files. If ~$filename from $sources-dir is found in # ~$dist-info then just assume everything worked correctly my $filename = $sources-dir.dir.first(*.f).basename; my $dist-info = $dist-dir.dir.first(*.f).slurp; ok $dist-info.contains($filename), 'Verify install succeeded'; }, 'install'; subtest { subtest { test-install(); # XXX: Need to find a way to test when this fails is +@installed, 1, 'Installed nothing new'; is +$dist-dir.dir.grep(*.f), 1, 'Only a single distribution file should still exist'; my $filename = $sources-dir.dir.first(*.f).basename; my $dist-info = $dist-dir.dir.first(*.f).slurp; ok $dist-info.contains($filename), 'Verify previous install appears valid'; }, 'Without force'; subtest { temp $client.force-install = True; my @installed = test-install(); is +@installed, 1, 'Install count remains 1'; is +$dist-dir.dir.grep(*.f), 1, 'Only a single distribution file should still exist'; my $filename = ~$sources-dir.dir.first(*.f).basename; my $dist-info = ~$dist-dir.dir.first(*.f).slurp; ok $dist-info.contains($filename), 'Verify reinstall appears valid'; }, 'With force-install'; }, 'reinstall'; subtest { +@cur.grep(*.can('uninstall')) == 0 ?? skip("Need a newer rakudo for uninstall") !! do { my @uninstalled = Zef::Client.new(:$config).uninstall( :from(@cur), |@installed>>.dist>>.identity ); is +@uninstalled, 1, 'Uninstalled a single module'; is +$sources-dir.dir, 0, 'No source files should remain'; is +$dist-dir.dir, 0, 'No distribution files should remain'; } }, 'uninstall'; zef-0.8.2/xt/repository.t000066400000000000000000000057371355757230100153700ustar00rootroot00000000000000use v6; use Test; plan 3; use Zef; use Zef::Repository; use Zef::Repository::Ecosystems; use Zef::Fetch; subtest { class Mock::Repository does Repository { method search(:$max-results = 5, *@identities, *%fields) { my @candidates = Candidate.new(:as("{@identities[0]}::X")), Candidate.new(:as("{@identities[0]}::XX")); } } subtest { my $mock-repository = Mock::Repository.new; my @candidates = $mock-repository.search("Mock::Repository"); is +@candidates, 2; is @candidates[0].as, "Mock::Repository::X"; is @candidates[1].as, "Mock::Repository::XX"; }, "Mock::Repository"; subtest { my $mock-repository1 = Mock::Repository.new; my $mock-repository2 = Mock::Repository.new; my $repository = Zef::Repository.new but role :: { method plugins { state @plugins = $mock-repository1, $mock-repository2 } } my @candidates = $repository.search("Mock::Repository"); is +@candidates, 4; is @candidates[0].as, "Mock::Repository::X"; is @candidates[1].as, "Mock::Repository::XX"; is @candidates[2].as, "Mock::Repository::X"; is @candidates[3].as, "Mock::Repository::XX"; }, 'Zef::Repository service aggregation' }, "Repository"; subtest { my $wanted = 'zef'; my @mirrors = 'git://github.com/ugexe/Perl6-ecosystems.git'; my @backends = [ { module => "Zef::Service::Shell::git" }, { module => "Zef::Service::Shell::wget" }, { module => "Zef::Service::Shell::curl" }, { module => "Zef::Service::Shell::PowerShell::download" }, ]; my $fetcher = Zef::Fetch.new(:@backends); my $cache = $*HOME.child('.zef/store').absolute andthen { mkdir $_ unless $_.IO.e }; my $p6c = Zef::Repository::Ecosystems.new(name => 'p6c', :$fetcher, :$cache, :auto-update, :@mirrors); ok $p6c.available > 0; subtest { my @candidates = $p6c.search($wanted, :strict); ok +@candidates > 0; is @candidates.grep({ .dist.name ne $wanted }).elems, 0; }, 'search'; }, "Ecosystems => p6c"; subtest { my $wanted = 'zef'; my @mirrors = 'https://raw.githubusercontent.com/ugexe/Perl6-ecosystems/11efd9077b398df3766eaa7cf8e6a9519f63c272/cpan.json'; my @backends = [ { module => "Zef::Service::Shell::wget" }, { module => "Zef::Service::Shell::curl" }, { module => "Zef::Service::Shell::PowerShell::download" }, ]; my $fetcher = Zef::Fetch.new(:@backends); my $cache = $*HOME.child('.zef/store').absolute andthen { mkdir $_ unless $_.IO.e }; my $cpan = Zef::Repository::Ecosystems.new(name => 'cpan', :$fetcher, :$cache, :auto-update, :@mirrors); ok $cpan.available > 0; subtest { my @candidates = $cpan.search($wanted, :strict); ok +@candidates > 0; is @candidates.grep({ .dist.name ne $wanted }).elems, 0; }, 'search'; }, "Ecosystems => cpan"; done-testing;