├── .circleci └── config.yml ├── .dockerignore ├── .editorconfig ├── .github ├── CONTRIBUTING.md ├── ISSUE_TEMPLATE.md ├── dependabot.yml └── workflows │ ├── automerge.yml │ ├── build-deployment-container.yml │ ├── build-production-container.yml │ └── update-snapshot.yml ├── .gitignore ├── .mailmap ├── .perlcriticrc ├── .perltidyrc ├── Dockerfile ├── LICENSE ├── README.md ├── SECURITY.md ├── app.psgi ├── bin ├── api.pl ├── cpantesters_api_file_for_testing ├── cpantesters_mini_db_for_testing ├── cron │ ├── author.sh │ └── backups.sh ├── metacpan ├── mirror_cpan_for_developers.pl ├── munin │ └── monitor_minion_queue.pl ├── queue.pl ├── run └── wait-for-open ├── codecov.yml ├── cpanfile ├── cpanfile.snapshot ├── deploy ├── build.sh ├── push.sh └── vars.sh ├── docs ├── API-docs.md ├── authentication.md ├── debugging.md ├── dependencies.md ├── indexing.md ├── logging.md └── testing.md ├── es ├── account │ ├── mapping.json │ └── settings.json ├── author │ ├── mapping.json │ └── settings.json ├── contributor │ ├── mapping.json │ └── settings.json ├── cover │ ├── mapping.json │ └── settings.json ├── cve │ ├── mapping.json │ └── settings.json ├── distribution │ ├── mapping.json │ └── settings.json ├── favorite │ ├── mapping.json │ └── settings.json ├── file │ ├── mapping.json │ └── settings.json ├── mirror │ ├── mapping.json │ └── settings.json ├── package │ ├── mapping.json │ └── settings.json ├── permission │ ├── mapping.json │ └── settings.json ├── release │ ├── mapping.json │ └── settings.json ├── session │ ├── mapping.json │ └── settings.json └── settings.json ├── git ├── hooks │ └── pre-commit └── setup.sh ├── improve-search-results ├── .gitignore ├── README.md ├── app.pl ├── cpanfile └── cpanfile.snapshot ├── lib ├── Catalyst │ ├── Action │ │ ├── Deserialize │ │ │ └── MetaCPANSanitizedJSON.pm │ │ └── Serialize │ │ │ └── MetaCPANSanitizedJSON.pm │ ├── Authentication │ │ └── Store │ │ │ └── Proxy.pm │ └── Plugin │ │ └── Session │ │ └── Store │ │ └── ElasticSearch.pm ├── ElasticSearchX │ └── Model │ │ └── Document │ │ ├── Role.pm │ │ └── Set.pm └── MetaCPAN │ ├── API.pm │ ├── API │ ├── Controller │ │ ├── Admin.pm │ │ ├── Cover.pm │ │ ├── Queue.pm │ │ └── Search.pm │ ├── Model │ │ ├── Cover.pm │ │ ├── Download.pm │ │ ├── Role │ │ │ └── ES.pm │ │ └── User.pm │ └── Plugin │ │ └── Model.pm │ ├── Document │ ├── Author.pm │ ├── Author │ │ └── Profile.pm │ ├── CVE.pm │ ├── Contributor.pm │ ├── Cover.pm │ ├── Dependency.pm │ ├── Distribution.pm │ ├── Favorite.pm │ ├── File.pm │ ├── Mirror.pm │ ├── Module.pm │ ├── Package.pm │ ├── Permission.pm │ └── Release.pm │ ├── ESConfig.pm │ ├── Model.pm │ ├── Model │ ├── Archive.pm │ ├── ESWrapper.pm │ ├── Email │ │ └── PAUSE.pm │ ├── Hacks.pm │ ├── Release.pm │ └── User │ │ ├── Account.pm │ │ ├── Account │ │ └── Set.pm │ │ ├── Identity.pm │ │ └── Session.pm │ ├── Pod │ └── Renderer.pm │ ├── Query.pm │ ├── Query │ ├── Author.pm │ ├── CVE.pm │ ├── Contributor.pm │ ├── Cover.pm │ ├── Distribution.pm │ ├── Favorite.pm │ ├── File.pm │ ├── Mirror.pm │ ├── Package.pm │ ├── Permission.pm │ ├── Release.pm │ ├── Role │ │ └── Common.pm │ └── Search.pm │ ├── Role │ ├── HasConfig.pm │ ├── HasRogueDistributions.pm │ ├── Logger.pm │ └── Script.pm │ ├── Script │ ├── Author.pm │ ├── Backpan.pm │ ├── Backup.pm │ ├── CPANTesters.pm │ ├── CPANTestersAPI.pm │ ├── CVE.pm │ ├── Check.pm │ ├── Checksum.pm │ ├── Contributor.pm │ ├── Cover.pm │ ├── External.pm │ ├── Favorite.pm │ ├── First.pm │ ├── Latest.pm │ ├── Mapping.pm │ ├── Mirrors.pm │ ├── Package.pm │ ├── Permission.pm │ ├── Purge.pm │ ├── Queue.pm │ ├── Release.pm │ ├── Restart.pm │ ├── River.pm │ ├── Role │ │ ├── Contributor.pm │ │ └── External │ │ │ ├── Cygwin.pm │ │ │ └── Debian.pm │ ├── Runner.pm │ ├── Session.pm │ ├── Snapshot.pm │ ├── Suggest.pm │ ├── Tickets.pm │ └── Watcher.pm │ ├── Server.pm │ ├── Server │ ├── Action │ │ └── Deserialize.pm │ ├── Config.pm │ ├── Controller.pm │ ├── Controller │ │ ├── Activity.pm │ │ ├── Author.pm │ │ ├── CVE.pm │ │ ├── Changes.pm │ │ ├── Contributor.pm │ │ ├── Cover.pm │ │ ├── Diff.pm │ │ ├── Distribution.pm │ │ ├── Favorite.pm │ │ ├── File.pm │ │ ├── Login.pm │ │ ├── Login │ │ │ ├── GitHub.pm │ │ │ ├── Google.pm │ │ │ ├── PAUSE.pm │ │ │ └── Twitter.pm │ │ ├── Mirror.pm │ │ ├── Module.pm │ │ ├── OAuth2.pm │ │ ├── Package.pm │ │ ├── Permission.pm │ │ ├── Pod.pm │ │ ├── Rating.pm │ │ ├── Release.pm │ │ ├── ReverseDependencies.pm │ │ ├── Root.pm │ │ ├── Scroll.pm │ │ ├── Search.pm │ │ ├── Search │ │ │ ├── Autocomplete.pm │ │ │ ├── DownloadURL.pm │ │ │ ├── History.pm │ │ │ └── Web.pm │ │ ├── Source.pm │ │ ├── User.pm │ │ └── User │ │ │ └── Favorite.pm │ ├── Diff.pm │ ├── Model │ │ ├── ES.pm │ │ ├── ESModel.pm │ │ ├── ESQuery.pm │ │ ├── Search.pm │ │ └── Source.pm │ ├── QuerySanitizer.pm │ ├── Role │ │ ├── JSONP.pm │ │ └── Request.pm │ ├── User.pm │ └── View │ │ ├── JSON.pm │ │ ├── JSONP.pm │ │ └── Pod.pm │ ├── Types.pm │ ├── Types │ ├── Internal.pm │ └── TypeTiny.pm │ └── Util.pm ├── log4perl.conf ├── log4perl_prod.conf ├── metacpan_server.yaml ├── metacpan_server_testing.yaml ├── perlimports.toml ├── precious.toml ├── root └── static │ ├── definitions │ ├── common.yml │ ├── definitions.yml │ └── results.yml │ ├── favicon.ico │ ├── index.html │ ├── requests │ ├── cover.yml │ ├── release.yml │ └── search.yml │ └── v1.yml ├── t ├── 00_setup.t ├── 01_darkpan.t ├── api │ ├── controller │ │ ├── admin.t │ │ ├── cover.t │ │ └── search │ │ │ ├── first.t │ │ │ └── web.t │ └── queue.t ├── config.t ├── document │ ├── author.t │ ├── file.t │ └── module.t ├── fff_tidyall.t ├── lib │ ├── MetaCPAN │ │ ├── DarkPAN.pm │ │ ├── Script │ │ │ └── MockError.pm │ │ ├── Server │ │ │ └── Test.pm │ │ ├── TestHelpers.pm │ │ ├── TestServer.pm │ │ └── Tests │ │ │ ├── Controller │ │ │ └── Search │ │ │ │ └── DownloadURL.pm │ │ │ ├── Distribution.pm │ │ │ ├── Extra.pm │ │ │ ├── PSGI.pm │ │ │ ├── Query.pm │ │ │ ├── Release.pm │ │ │ └── UserAgent.pm │ └── Module │ │ └── Faker │ │ └── Dist │ │ └── WithPerl.pm ├── model │ ├── archive.t │ ├── email │ │ └── pause.t │ ├── release.t │ ├── release │ │ ├── dependencies.t │ │ ├── metadata.t │ │ └── reverse_dependencies.t │ └── search.t ├── package.t ├── permission.t ├── pod │ └── renderer.t ├── query.t ├── query │ └── release.t ├── release │ ├── badpod.t │ ├── binary-data.t │ ├── bugs.t │ ├── common-files.t │ ├── devel-gofaster-0.000.t │ ├── documentation-hide.t │ ├── documentation-not-readme.t │ ├── file-changes.t │ ├── file-duplicates.t │ ├── ipsonar-0.29.t │ ├── local-lib.t │ ├── meta-license.t │ ├── meta-provides.t │ ├── moose.t │ ├── multiple-modules.t │ ├── no-modules.t │ ├── no-packages.t │ ├── oops-locallib.t │ ├── p-1.0.20.t │ ├── packages-unclaimable.t │ ├── packages.t │ ├── perl-changes-file.t │ ├── pm-PL.t │ ├── pod-examples.t │ ├── pod-pm.t │ ├── pod-with-data-token.t │ ├── pod-with-generator.t │ ├── prefer-meta-json.t │ ├── scripts.t │ ├── some-trial.t │ ├── text-tabs-wrap.t │ ├── versions.t │ ├── weblint++-1.15.t │ └── www-tumblr-0.t ├── script │ ├── cover.t │ ├── load.t │ ├── queue.t │ ├── river.t │ └── runner.t ├── server │ ├── controller │ │ ├── author.t │ │ ├── bad_request.t │ │ ├── changes.t │ │ ├── contributor.t │ │ ├── cover.t │ │ ├── diff.t │ │ ├── distribution.t │ │ ├── download_url.t │ │ ├── file.t │ │ ├── login │ │ │ └── pause.t │ │ ├── mirror.t │ │ ├── module.t │ │ ├── package.t │ │ ├── permission.t │ │ ├── pod.t │ │ ├── rating.t │ │ ├── release.t │ │ ├── root.t │ │ ├── scroll.t │ │ ├── search │ │ │ └── autocomplete.t │ │ ├── source.t │ │ ├── url_parameters.pm │ │ └── user │ │ │ └── favorite.t │ ├── not_found.t │ └── sanitize_query.t ├── test-vars.t ├── testrules.yml ├── types.t ├── util.t └── var │ ├── cover.json │ ├── cpantesters-release-api-fake.json │ ├── cpantesters-release-fake.db.bz2 │ └── river.json ├── templates ├── admin │ ├── identity_search_form.html.ep │ ├── index.html.ep │ └── search_identities.html.ep ├── layouts │ └── default.html.ep └── queue │ └── index_release.html.ep ├── test-data └── fakecpan │ ├── 00whois.xml │ ├── 08pumpkings.txt.gz │ ├── author-1.0.json │ ├── bugs.tsv │ ├── configs │ ├── MIYAGAWA_CPAN-Test-Dummy-Perl5-VersionBump-0.01.tar.gz.dist │ ├── MIYAGAWA_CPAN-Test-Dummy-Perl5-VersionBump-0.02.tar.gz.dist │ ├── badpod.json │ ├── binary-data.pl │ ├── common-files.yml │ ├── devel-gofaster-0.000.yml │ ├── documentation-hide.json │ ├── documentation-not-readme.json │ ├── encoding-1.0.pl │ ├── encoding-1.1.pl │ ├── encoding-1.2.pl │ ├── file-changes-1.json │ ├── file-changes-2.json │ ├── file-changes-latin1.json │ ├── file-changes-news.json │ ├── file-changes-utf8.json │ ├── file-duplicates.pl │ ├── ipsonar-0.29.yml │ ├── local-lib.json │ ├── meta-license-dual.json │ ├── meta-license-single.json │ ├── meta-provides-1.01.json │ ├── metafile-both.json │ ├── metafile-json.json │ ├── metafile-yaml.json │ ├── moose-recent.json │ ├── moose.json │ ├── multiple-modules-0.1.json │ ├── multiple-modules-1.01.json │ ├── multiple-modules-rdeps-0.11.json │ ├── multiple-modules-rdeps-2.03.json │ ├── multiple-modules-rdeps-a.json │ ├── multiple-modules-rdeps-deprecated.json │ ├── multiple-modules-tester.json │ ├── no-modules.yml │ ├── no-packages.yml │ ├── oops-locallib.json │ ├── p-1.0.20.yml │ ├── packages-unclaimable.json │ ├── packages.json │ ├── perl-1.json │ ├── pod-examples.json │ ├── pod-pm.json │ ├── pod-with-data-token.json │ ├── pod-with-generator.json │ ├── prefer-meta-json.json │ ├── prereqs.json │ ├── scripts.json │ ├── some-trial.json │ ├── text-tabs+wrap-2013.0523.yml │ ├── uncommon-sense.json │ ├── versions.json │ ├── weblint++-1.15.yml │ └── www-tumblr-0.yml │ └── mirrors.json ├── tidyall.ini ├── wait-for-es.sh ├── wait-for-it.sh └── xt ├── README.txt └── search_web.t /.dockerignore: -------------------------------------------------------------------------------- 1 | .gitignore -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # EditorConfig helps developers define and maintain consistent 2 | # coding styles between different editors and IDEs 3 | # editorconfig.org 4 | 5 | root = true 6 | 7 | [*] 8 | 9 | indent_style = space 10 | indent_size = 4 11 | 12 | # We recommend you to keep these unchanged 13 | end_of_line = lf 14 | charset = utf-8 15 | 16 | # I'd like to enable this, but we should fix all the files first to avoid diff noise. 17 | #trim_trailing_whitespace = true 18 | insert_final_newline = true 19 | 20 | # yaml indents are weird 21 | [*.{yml,yaml}] 22 | indent_size = 2 23 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | # Important, please read: 2 | 3 | MetaCPAN's core developers need to focus on fixing bugs and improving the 4 | existing core system. 5 | 6 | For this reason, if you have a feature which you would like to see added (there 7 | are loads we would love to have), please only open an issue _IF_ you are 8 | prepared to do the work to implement it. To be clear, we'd love to have a 9 | bunch of really cool, new, features, but it's more important for us to focus on 10 | keeping MetaCPAN humming along. 11 | 12 | If you're not motivated or otherwise able to send a pull request for your cool, 13 | new feature, please add it to our wishlist: 14 | https://github.com/CPAN-API/cpan-api/wiki/Wishlist and someone may get to it 15 | one day. Maybe that person will be you! 16 | 17 | For more details on issues and contributing please see CONTRIBUTING.md (linked 18 | above). 19 | -------------------------------------------------------------------------------- /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | --- 2 | version: 2 3 | updates: 4 | - package-ecosystem: 'github-actions' 5 | directory: '/' 6 | schedule: 7 | # Check for updates to GitHub Actions every week 8 | interval: 'weekly' 9 | -------------------------------------------------------------------------------- /.github/workflows/automerge.yml: -------------------------------------------------------------------------------- 1 | name: Maybe Enable Auto-Merge 2 | on: 3 | pull_request_target: 4 | types: [opened] 5 | 6 | jobs: 7 | enable-auto-merge: 8 | runs-on: ubuntu-latest 9 | if: github.event.pull_request.user.login == 'metacpan-automation[bot]' 10 | steps: 11 | - name: Generate Auth Token 12 | id: auth-token 13 | uses: jamestrousdale/github-app-jwt-token@0.1.4 14 | with: 15 | app-id: ${{ secrets.APP_ID }} 16 | private-key: ${{ secrets.APP_PRIVATE_KEY }} 17 | - uses: peter-evans/enable-pull-request-automerge@v3 18 | with: 19 | token: ${{ steps.auth-token.outputs.access-token }} 20 | pull-request-number: ${{ github.event.pull_request.number }} 21 | -------------------------------------------------------------------------------- /.github/workflows/build-deployment-container.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: Build deployment container 3 | on: 4 | push: 5 | branches: 6 | - prod 7 | - staging 8 | workflow_dispatch: 9 | jobs: 10 | docker: 11 | runs-on: ubuntu-22.04 12 | name: Docker push SHA 13 | steps: 14 | - uses: actions/checkout@v4 15 | - name: docker build 16 | run: docker build . -t metacpan/metacpan-api:$GITHUB_SHA 17 | - name: run Perl tests 18 | run: docker run -i metacpan/metacpan-api carton exec prove -lr --jobs 2 t 19 | - name: Log in to Docker Hub 20 | uses: docker/login-action@v3 21 | with: 22 | username: ${{ secrets.DOCKER_HUB_USER }} 23 | password: ${{ secrets.DOCKER_HUB_TOKEN }} 24 | - name: push build to Docker hub 25 | run: docker push metacpan/metacpan-api:$GITHUB_SHA 26 | 27 | -------------------------------------------------------------------------------- /.github/workflows/build-production-container.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: Build Production Container 3 | on: 4 | push: 5 | branches: 6 | - master 7 | workflow_dispatch: 8 | 9 | jobs: 10 | docker: 11 | runs-on: ubuntu-22.04 12 | name: Docker push latest 13 | steps: 14 | - uses: actions/checkout@v4 15 | - name: docker build 16 | run: docker build . -t metacpan/metacpan-api:latest 17 | - name: Login to Docker Hub 18 | uses: docker/login-action@v3 19 | with: 20 | username: ${{ secrets.DOCKER_HUB_USER }} 21 | password: ${{ secrets.DOCKER_HUB_TOKEN }} 22 | - name: push build to Docker hub 23 | run: docker push metacpan/metacpan-api:latest 24 | if: success() && github.ref == 'refs/heads/master' 25 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /MYMETA.* 2 | /Makefile 3 | /Makefile.old 4 | /blib 5 | /cover_db/ 6 | /local/ 7 | /log4perl_local.conf 8 | /metacpan_server_local.* 9 | /metacpan_server_testing_local.* 10 | /perltidy.LOG 11 | /pm_to_blib 12 | /var 13 | /etc/metacpan_local.pl 14 | /t/var/darkpan/ 15 | /t/var/log/ 16 | /t/var/tmp/ 17 | *.komodoproject 18 | *.kpf 19 | *.sqlite* 20 | *.sw* 21 | .DS_Store 22 | .tidyall.d 23 | -------------------------------------------------------------------------------- /.perlcriticrc: -------------------------------------------------------------------------------- 1 | # please alpha sort config items as you add them 2 | 3 | severity = 5 4 | verbose = 11 5 | theme = core 6 | 7 | [-ControlStructures::ProhibitPostfixControls] 8 | [-Documentation::RequirePodSections] 9 | [-InputOutput::ProhibitInteractiveTest] 10 | [-Modules::RequireVersionVar] 11 | [-RegularExpressions::RequireDotMatchAnything] 12 | [-RegularExpressions::RequireExtendedFormatting] 13 | [-RegularExpressions::RequireLineBoundaryMatching] 14 | [-Subroutines::ProhibitExplicitReturnUndef] 15 | [-TestingAndDebugging::ProhibitNoStrict] 16 | [-ValuesAndExpressions::ProhibitNoisyQuotes] 17 | [-Variables::ProhibitPunctuationVars] 18 | 19 | # doesn't understand signatures 20 | [-Subroutines::ProhibitSubroutinePrototypes] 21 | 22 | [CodeLayout::RequireTrailingCommas] 23 | severity = 4 24 | 25 | [TestingAndDebugging::RequireUseStrict] 26 | equivalent_modules = MetaCPAN::Moose Mojo::Base Test::Routine 27 | 28 | [TestingAndDebugging::RequireUseWarnings] 29 | equivalent_modules = MetaCPAN::Moose Mojo::Base Test::Routine 30 | 31 | [ValuesAndExpressions::ProhibitEmptyQuotes] 32 | severity = 4 33 | 34 | [ValuesAndExpressions::ProhibitInterpolationOfLiterals] 35 | allow_if_string_contains_single_quote = 1 36 | allow = qq{} qq[] 37 | severity = 4 38 | 39 | [ValuesAndExpressions::ProhibitNoisyQuotes] 40 | severity = 4 41 | -------------------------------------------------------------------------------- /.perltidyrc: -------------------------------------------------------------------------------- 1 | --maximum-line-length=78 2 | --indent-columns=4 3 | --continuation-indentation=4 4 | --standard-error-output 5 | --vertical-tightness=2 6 | --closing-token-indentation=0 7 | --paren-tightness=1 8 | --brace-tightness=1 9 | --square-bracket-tightness=1 10 | --block-brace-tightness=1 11 | --nospace-for-semicolon 12 | --nooutdent-long-quotes 13 | --want-break-before="% + - * / x != == >= <= =~ !~ < > | & = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=" 14 | # Break a line after opening/before closing token. 15 | --vertical-tightness=0 16 | --vertical-tightness-closing=0 17 | --weld-nested-containers 18 | -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | # hadolint ignore=DL3007 2 | FROM metacpan/metacpan-base:latest 3 | 4 | COPY cpanfile cpanfile.snapshot /metacpan-api/ 5 | WORKDIR /metacpan-api 6 | 7 | # CPM installations of dependencies does not install or run tests. This is 8 | # because the modules themselves have been tested, and the metacpan use of the 9 | # modules is tested by the test suite. Removing the tests, reduces the overall 10 | # size of the images. 11 | RUN mkdir /CPAN \ 12 | && apt-get update \ 13 | && apt-get satisfy -y --no-install-recommends 'rsync (>= 3.2.3)' 'jq (>= 1.6)' \ 14 | && apt-get clean \ 15 | && rm -rf /var/lib/apt/lists/* \ 16 | && cpm install --global \ 17 | && git config --global --add safe.directory /metacpan-api \ 18 | && rm -fr /root/.cpanm /root/.perl-cpm /var/cache/apt/lists/* /tmp/* 19 | 20 | VOLUME /CPAN 21 | 22 | EXPOSE 5000 23 | 24 | CMD [ "/wait-for-it.sh", "${PGDB}", "--", "${API_SERVER}", "./bin/api.pl" ] 25 | -------------------------------------------------------------------------------- /SECURITY.md: -------------------------------------------------------------------------------- 1 | # Security Policy 2 | 3 | ## Supported Versions 4 | 5 | | Version | Supported | 6 | | ------- | ------------------ | 7 | | `master` branch | :white_check_mark: | 8 | 9 | ## Reporting a Vulnerability 10 | 11 | Please report all vulnerabilities by sending an email to noc@metacpan.org 12 | -------------------------------------------------------------------------------- /bin/api.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | =head2 DESCRIPTION 7 | 8 | This is the API web server interface. 9 | 10 | # On vagrant VM 11 | ./bin/run morbo bin/api.pl 12 | 13 | To run the api web server, run the following on one of the servers: 14 | 15 | # Run the daemon on a local port (tunnel to display on your browser) 16 | ./bin/run bin/api.pl daemon 17 | 18 | Start Minion worker on vagrant: 19 | 20 | cd /home/vagrant/metacpan-api 21 | ./bin/run bin/api.pl minion worker 22 | 23 | Get status on jobs and workers. 24 | 25 | On production: 26 | 27 | sh /home/metacpan/bin/metacpan-api-carton-exec bin/api.pl minion job -s 28 | 29 | On vagrant: 30 | 31 | cd /home/vagrant/metacpan-api 32 | ./bin/run bin/api.pl minion job -s 33 | 34 | =cut 35 | 36 | use lib 'lib'; 37 | 38 | # Start command line interface for application 39 | require Mojolicious::Commands; 40 | Mojolicious::Commands->start_app('MetaCPAN::API'); 41 | -------------------------------------------------------------------------------- /bin/cpantesters_api_file_for_testing: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | cd `dirname "$0"` 4 | cd .. 5 | 6 | url=http://api.cpantesters.org/v3/release 7 | in=t/var/tmp/cpantesters-release-api.json 8 | out=t/var/cpantesters-release-api-fake.json 9 | 10 | download_original () { 11 | test -s "$in" || wget -O "$in" "$url" 12 | } 13 | 14 | append_json () { 15 | perl -MJSON::PP -e' 16 | $file = shift; 17 | $all = -e $file ? decode_json( 18 | do { local $/; open $fh, "<", $file; <$fh> } 19 | ) : []; 20 | $add = decode_json( join "", ); 21 | push @$all, $add; 22 | open $fh, ">", $file; 23 | print { $fh } encode_json( $all ) ' $out 24 | } 25 | 26 | collect_dist () { 27 | local dist="$1" version="$2" 28 | jq '.[] | select( .dist == $dist and .version == $version )' \ 29 | --arg dist "$dist" --arg version "$version" $in \ 30 | | append_json 31 | } 32 | 33 | fake_dist () { 34 | echo "{ \"dist\": \"$1\", \"version\": \"$2\", \"pass\": $3, \"fail\": $4, \ 35 | \"na\": $5, \"unknown\": $6 }" | append_json; 36 | } 37 | 38 | populate_file () { 39 | rm -f "$out" 40 | 41 | # Get test cases from real data. 42 | collect_dist 'Devel-GoFaster' '0.000' 43 | collect_dist 'P' '1.0.20' 44 | collect_dist 'IPsonar' '0.29' 45 | collect_dist 'weblint' '++-1.15' 46 | collect_dist 'WWW-Tumblr' '' 47 | 48 | # Add records for our fake dists. 49 | fake_dist 'Some' '1.00-TRIAL' 4 3 2 1 50 | } 51 | 52 | if [ !-x $( which jq ) ]; then 53 | echo "ERROR: jq(1) required for this script" 54 | exit 1 55 | fi 56 | 57 | download_original 58 | populate_file 59 | 60 | -------------------------------------------------------------------------------- /bin/cpantesters_mini_db_for_testing: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | cd `dirname "$0"` 4 | cd .. 5 | 6 | url=http://devel.cpantesters.org/release/release.db.bz2 7 | in=t/var/tmp/cpantesters-release.db 8 | out=t/var/cpantesters-release-fake.db 9 | table=release 10 | 11 | download_original () { 12 | test -s "$in" || \ 13 | wget -O "$in.bz2" "$url" 14 | test -f "$in.bz2" && \ 15 | bunzip2 "$in.bz2" 16 | 17 | rm -f "$out" "$out.bz2" 18 | } 19 | 20 | finish () { 21 | # Compress the db like cpantesters does. 22 | bzip2 "$out" 23 | } 24 | 25 | sqlout () { sqlite3 "$out"; } 26 | sql () { 27 | sqlite3 "$in" | sqlout 28 | } 29 | 30 | dist_version () { 31 | local dist="$1" version="$2" 32 | cat <run; 22 | 23 | exit $MetaCPAN::Script::Runner::EXIT_CODE; 24 | -------------------------------------------------------------------------------- /bin/mirror_cpan_for_developers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | 5 | # This script is only needed if you are developing metacpan, 6 | # on the live servers we use File::Rsync::Mirror::Recent 7 | # https://github.com/metacpan/metacpan-puppet/tree/master/modules/rrrclient 8 | 9 | use CPAN::Mini; 10 | 11 | CPAN::Mini->update_mirror( 12 | remote => 'http://www.cpan.org/', 13 | local => "/home/metacpan/CPAN", 14 | log_level => 'warn', 15 | ); 16 | -------------------------------------------------------------------------------- /bin/munin/monitor_minion_queue.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | # Munin runs this as metacpan user, but with root's env 7 | # it's only for production so path is hard coded 8 | 9 | my $config_mode = 0; 10 | $config_mode = 1 if $ARGV[0] && $ARGV[0] eq 'config'; 11 | 12 | if ($config_mode) { 13 | 14 | # Dump this (though we supported dynamic below) so it's faster 15 | print <<'EOF'; 16 | graph_title Minion Queue stats 17 | graph_vlabel count 18 | graph_category metacpan_api 19 | graph_info What's happening in the Minion queue 20 | workers_inactive.label Inactive workers 21 | workers_active.label Active workers 22 | jobs_inactive.label Inactive jobs 23 | jobs_active.label Active jobs 24 | jobs_failed.label Failed jobs 25 | jobs_finished.label Finished jobs 26 | EOF 27 | 28 | exit; 29 | } 30 | 31 | # Get the stats 32 | my $stats_report 33 | = `/home/metacpan/bin/metacpan-api-carton-exec bin/queue.pl minion job -s`; 34 | 35 | my @lines = split( "\n", $stats_report ); 36 | 37 | for my $line (@lines) { 38 | my ( $label, $num ) = split ':', $line; 39 | 40 | $num =~ s/\D//g; 41 | 42 | my $key = lc($label); # Was 'Inactive jobs' 43 | 44 | # Swap type and status around so idle_jobs becomes jobs_idle 45 | $key =~ s/(\w+)\s+(\w+)/$2_$1/g; 46 | 47 | if ($config_mode) { 48 | 49 | # config 50 | print "${key}.label $label\n"; 51 | 52 | } 53 | else { 54 | # results 55 | print "${key}.value $num\n" if $num; 56 | } 57 | 58 | } 59 | -------------------------------------------------------------------------------- /bin/queue.pl: -------------------------------------------------------------------------------- 1 | api.pl -------------------------------------------------------------------------------- /bin/run: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Use the puppet-installed wrapper to set up the env properly. 4 | wrapper=$HOME/bin/metacpan-api-carton 5 | test -x $wrapper && \ 6 | exec $wrapper exec -- "$@" 7 | 8 | # If the wrapper doesn't exist, just try it with plain carton. 9 | cd "`dirname "$0"`"/.. 10 | exec carton exec -- "$@" 11 | -------------------------------------------------------------------------------- /bin/wait-for-open: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | 5 | my $server = shift; 6 | 7 | my $timeout = 30; 8 | while ( $timeout-- ) { 9 | if ( !system "curl -s '$server' 2>/dev/null 1>&2" ) { 10 | exit 0; 11 | } 12 | sleep 1; 13 | } 14 | 15 | print STDERR "Timed out starting elasticsearch!\n"; 16 | exit 1; 17 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | --- 2 | comment: 3 | layout: 'diff, files' 4 | behavior: default 5 | require_changes: true # if true: only post the comment if coverage changes 6 | require_base: false # [true :: must have a base report to post] 7 | require_head: true # [true :: must have a head report to post] 8 | hide_project_coverage: false # [true :: only show coverage on the git diff] 9 | coverage: 10 | status: 11 | patch: 12 | default: 13 | threshold: 1% 14 | project: 15 | default: 16 | threshold: 1% 17 | -------------------------------------------------------------------------------- /deploy/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | DEPLOY_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null 2>&1 && pwd )" 4 | 5 | source "${DEPLOY_DIR}/vars.sh" 6 | 7 | # ## Go to where the docker file is 8 | cd "${DEPLOY_DIR}/.." 9 | 10 | ## Pull the latest docker file from docker hub if there is one 11 | docker pull "$DOCKER_HUB_NAME" || true 12 | 13 | ## Issue the build command, adding tags (from CONFIG.sh) 14 | docker build --pull --cache-from "$DOCKER_HUB_NAME" --tag $DOCKER_HUB_NAME --tag $VERSION_TAG . 15 | -------------------------------------------------------------------------------- /deploy/push.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | DEPLOY_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null 2>&1 && pwd )" 4 | 5 | source "${DEPLOY_DIR}/vars.sh" 6 | 7 | cd "${DEPLOY_DIR}/.." 8 | 9 | docker login -u "$DOCKER_HUB_USER" -p "$DOCKER_HUB_PASSWD" 10 | 11 | docker push "$DOCKER_HUB_NAME" -------------------------------------------------------------------------------- /deploy/vars.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ## Edit this 4 | if [ -z $DOCKER_IMAGE_NAME ]; then 5 | echo "DOCKER_IMAGE_NAME is not defined" 6 | exit 1; 7 | fi 8 | 9 | ## Should not need to edit this 10 | export DOCKER_HUB_NAME="metacpan/${DOCKER_IMAGE_NAME}" 11 | export VERSION="${TRAVIS_BUILD_NUMBER:-UNKNOWN-BUILD-NUMBER}" 12 | export VERSION_TAG="${DOCKER_HUB_NAME}:${VERSION}" 13 | 14 | -------------------------------------------------------------------------------- /docs/authentication.md: -------------------------------------------------------------------------------- 1 | # User Authentication 2 | 3 | We're using https://metacpan.org/pod/Catalyst::Plugin::Authentication This 4 | module provides user() and user_exists() to the controllers. 5 | -------------------------------------------------------------------------------- /docs/debugging.md: -------------------------------------------------------------------------------- 1 | # Debugging 2 | 3 | To start the app in debug mode: 4 | 5 | METACPAN_SERVER_DEBUG=1 plackup 6 | -------------------------------------------------------------------------------- /docs/dependencies.md: -------------------------------------------------------------------------------- 1 | # Carton 2 | 3 | We use Carton to manage and pin our dependencies. To run carton on the VM, you 4 | have two options: 5 | 6 | vagrant provision 7 | 8 | This will run a `carton install` along with any other general bootstrapping 9 | which is required, but it can be a bit slow. 10 | 11 | If you ssh to your vagrant box, this is faster: 12 | 13 | sh /home/vagrant/bin/metacpan-api-carton install 14 | -------------------------------------------------------------------------------- /docs/logging.md: -------------------------------------------------------------------------------- 1 | # Logging 2 | 3 | Logging is done via Log::Contextual. There are three logger configs. These 4 | can be found in the etc folder in this repository. 5 | 6 | ## etc/metacpan.pl 7 | 8 | This is the default logger config 9 | 10 | ## etc/metacpan_interactive.pl 11 | 12 | This logger config is used when scripts are run at the command line 13 | 14 | ## etc/metacpan_testing.pl 15 | 16 | This logger config is used by the test suite. 17 | -------------------------------------------------------------------------------- /docs/testing.md: -------------------------------------------------------------------------------- 1 | # Testing 2 | 3 | ## Releases 4 | 5 | When debugging the release indexing, try setting the bulk_size param to a low number, in order to make debugging easier. 6 | 7 | my $server = MetaCPAN::TestServer->new( ... ); 8 | $server->index_releases( bulk_size => 1 ); 9 | 10 | You can enable Elasticsearch tracing when running tests at the command line: 11 | 12 | ES_TRACE=1 ./bin/prove t/darkpan.t 13 | 14 | You'll then find extensive logging information in `es.log`, at the top level of your Git checkout. 15 | 16 | ## Indexing a Single Release 17 | 18 | If you want to speed up your debugging, you can index a solitary release using 19 | the `MC_RELEASE` environment variable. 20 | 21 | MC_RELEASE=var/t/tmp/fakecpan/authors/id/L/LO/LOCAL/P-1.0.20.tar.gz ./bin/prove t/00_setup.t 22 | 23 | Or combine this with a test specific to the release. 24 | 25 | MC_RELEASE=var/t/tmp/fakecpan/authors/id/L/LO/LOCAL/P-1.0.20.tar.gz ./bin/prove t/00_setup.t t/release/p-1.0.20.t 26 | -------------------------------------------------------------------------------- /es/account/mapping.json: -------------------------------------------------------------------------------- 1 | { 2 | "dynamic": false, 3 | "properties": { 4 | "access_token": { 5 | "dynamic": true, 6 | "properties": { 7 | "client": { 8 | "type": "keyword" 9 | }, 10 | "token": { 11 | "type": "keyword" 12 | } 13 | } 14 | }, 15 | "code": { 16 | "type": "keyword" 17 | }, 18 | "id": { 19 | "type": "keyword" 20 | }, 21 | "identity": { 22 | "dynamic": false, 23 | "properties": { 24 | "key": { 25 | "type": "keyword" 26 | }, 27 | "name": { 28 | "type": "keyword" 29 | } 30 | } 31 | } 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /es/account/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/author/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/contributor/mapping.json: -------------------------------------------------------------------------------- 1 | { 2 | "dynamic": false, 3 | "properties": { 4 | "distribution": { 5 | "type": "keyword" 6 | }, 7 | "email": { 8 | "type": "keyword" 9 | }, 10 | "name": { 11 | "type": "keyword" 12 | }, 13 | "pauseid": { 14 | "type": "keyword" 15 | }, 16 | "release_author": { 17 | "type": "keyword" 18 | }, 19 | "release_name": { 20 | "type": "keyword" 21 | } 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /es/contributor/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/cover/mapping.json: -------------------------------------------------------------------------------- 1 | { 2 | "dynamic": false, 3 | "properties": { 4 | "criteria": { 5 | "dynamic": true, 6 | "properties": { 7 | "branch": { 8 | "type": "float" 9 | }, 10 | "condition": { 11 | "type": "float" 12 | }, 13 | "statement": { 14 | "type": "float" 15 | }, 16 | "subroutine": { 17 | "type": "float" 18 | }, 19 | "total": { 20 | "type": "float" 21 | } 22 | } 23 | }, 24 | "distribution": { 25 | "type": "keyword" 26 | }, 27 | "release": { 28 | "type": "keyword" 29 | }, 30 | "version": { 31 | "type": "keyword" 32 | } 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /es/cover/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/cve/mapping.json: -------------------------------------------------------------------------------- 1 | { 2 | "dynamic": false, 3 | "properties": { 4 | "affected_versions": { 5 | "type": "text" 6 | }, 7 | "cpansa_id": { 8 | "type": "keyword" 9 | }, 10 | "cves": { 11 | "type": "text" 12 | }, 13 | "description": { 14 | "type": "text" 15 | }, 16 | "distribution": { 17 | "type": "keyword" 18 | }, 19 | "references": { 20 | "type": "text" 21 | }, 22 | "releases": { 23 | "type": "keyword" 24 | }, 25 | "reported": { 26 | "format": "strict_date_optional_time||epoch_millis", 27 | "type": "date" 28 | }, 29 | "severity": { 30 | "type": "text" 31 | }, 32 | "versions": { 33 | "type": "keyword" 34 | } 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /es/cve/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/distribution/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/favorite/mapping.json: -------------------------------------------------------------------------------- 1 | { 2 | "dynamic": false, 3 | "properties": { 4 | "author": { 5 | "type": "keyword" 6 | }, 7 | "date": { 8 | "format": "strict_date_optional_time||epoch_millis", 9 | "type": "date" 10 | }, 11 | "distribution": { 12 | "type": "keyword" 13 | }, 14 | "id": { 15 | "type": "keyword" 16 | }, 17 | "release": { 18 | "type": "keyword" 19 | }, 20 | "user": { 21 | "type": "keyword" 22 | } 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /es/favorite/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/file/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "analysis": { 3 | "analyzer": { 4 | "camelcase": { 5 | "filter": [ 6 | "lowercase", 7 | "unique" 8 | ], 9 | "tokenizer": "camelcase", 10 | "type": "custom" 11 | }, 12 | "edge": { 13 | "filter": [ 14 | "lowercase", 15 | "edge" 16 | ], 17 | "tokenizer": "standard", 18 | "type": "custom" 19 | }, 20 | "edge_camelcase": { 21 | "filter": [ 22 | "lowercase", 23 | "edge" 24 | ], 25 | "tokenizer": "camelcase", 26 | "type": "custom" 27 | }, 28 | "fulltext": { 29 | "type": "english" 30 | }, 31 | "lowercase": { 32 | "filter": "lowercase", 33 | "tokenizer": "keyword" 34 | } 35 | }, 36 | "filter": { 37 | "edge": { 38 | "max_gram": "20", 39 | "min_gram": "1", 40 | "type": "edge_ngram" 41 | } 42 | }, 43 | "tokenizer": { 44 | "camelcase": { 45 | "pattern": "([^\\p{L}\\d]+)|(?<=\\D)(?=\\d)|(?<=\\d)(?=\\D)|(?<=[\\p{L}&&[^\\p{Lu}]])(?=\\p{Lu})|(?<=\\p{Lu})(?=\\p{Lu}[\\p{L}&&[^\\p{Lu}]])", 46 | "type": "pattern" 47 | } 48 | } 49 | }, 50 | "number_of_replicas": 1, 51 | "number_of_shards": 1, 52 | "refresh_interval": "1s" 53 | } 54 | -------------------------------------------------------------------------------- /es/mirror/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/package/mapping.json: -------------------------------------------------------------------------------- 1 | { 2 | "dynamic": false, 3 | "properties": { 4 | "author": { 5 | "type": "keyword" 6 | }, 7 | "dist_version": { 8 | "type": "keyword" 9 | }, 10 | "distribution": { 11 | "type": "keyword" 12 | }, 13 | "file": { 14 | "type": "keyword" 15 | }, 16 | "module_name": { 17 | "type": "keyword" 18 | }, 19 | "version": { 20 | "type": "keyword" 21 | } 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /es/package/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/permission/mapping.json: -------------------------------------------------------------------------------- 1 | { 2 | "dynamic": false, 3 | "properties": { 4 | "co_maintainers": { 5 | "type": "keyword" 6 | }, 7 | "module_name": { 8 | "type": "keyword" 9 | }, 10 | "owner": { 11 | "type": "keyword" 12 | } 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /es/permission/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/release/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "analysis": { 3 | "analyzer": { 4 | "camelcase": { 5 | "filter": [ 6 | "lowercase", 7 | "unique" 8 | ], 9 | "tokenizer": "camelcase", 10 | "type": "custom" 11 | }, 12 | "edge": { 13 | "filter": [ 14 | "lowercase", 15 | "edge" 16 | ], 17 | "tokenizer": "standard", 18 | "type": "custom" 19 | }, 20 | "edge_camelcase": { 21 | "filter": [ 22 | "lowercase", 23 | "edge" 24 | ], 25 | "tokenizer": "camelcase", 26 | "type": "custom" 27 | }, 28 | "fulltext": { 29 | "type": "english" 30 | }, 31 | "lowercase": { 32 | "filter": "lowercase", 33 | "tokenizer": "keyword" 34 | } 35 | }, 36 | "filter": { 37 | "edge": { 38 | "max_gram": "20", 39 | "min_gram": "1", 40 | "type": "edge_ngram" 41 | } 42 | }, 43 | "tokenizer": { 44 | "camelcase": { 45 | "pattern": "([^\\p{L}\\d]+)|(?<=\\D)(?=\\d)|(?<=\\d)(?=\\D)|(?<=[\\p{L}&&[^\\p{Lu}]])(?=\\p{Lu})|(?<=\\p{Lu})(?=\\p{Lu}[\\p{L}&&[^\\p{Lu}]])", 46 | "type": "pattern" 47 | } 48 | } 49 | }, 50 | "number_of_replicas": 1, 51 | "number_of_shards": 1, 52 | "refresh_interval": "1s" 53 | } 54 | -------------------------------------------------------------------------------- /es/session/mapping.json: -------------------------------------------------------------------------------- 1 | { 2 | "dynamic": false 3 | } 4 | -------------------------------------------------------------------------------- /es/session/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "analysis": { 3 | "analyzer": { 4 | "camelcase": { 5 | "filter": [ 6 | "lowercase", 7 | "unique" 8 | ], 9 | "tokenizer": "camelcase", 10 | "type": "custom" 11 | }, 12 | "edge": { 13 | "filter": [ 14 | "lowercase", 15 | "edge" 16 | ], 17 | "tokenizer": "standard", 18 | "type": "custom" 19 | }, 20 | "edge_camelcase": { 21 | "filter": [ 22 | "lowercase", 23 | "edge" 24 | ], 25 | "tokenizer": "camelcase", 26 | "type": "custom" 27 | }, 28 | "fulltext": { 29 | "type": "english" 30 | }, 31 | "lowercase": { 32 | "filter": "lowercase", 33 | "tokenizer": "keyword" 34 | } 35 | }, 36 | "filter": { 37 | "edge": { 38 | "max_gram": "20", 39 | "min_gram": "1", 40 | "type": "edge_ngram" 41 | } 42 | }, 43 | "tokenizer": { 44 | "camelcase": { 45 | "pattern": "([^\\p{L}\\d]+)|(?<=\\D)(?=\\d)|(?<=\\d)(?=\\D)|(?<=[\\p{L}&&[^\\p{Lu}]])(?=\\p{Lu})|(?<=\\p{Lu})(?=\\p{Lu}[\\p{L}&&[^\\p{Lu}]])", 46 | "type": "pattern" 47 | } 48 | } 49 | }, 50 | "number_of_replicas": 1, 51 | "number_of_shards": 1, 52 | "refresh_interval": "1s" 53 | } 54 | -------------------------------------------------------------------------------- /git/hooks/pre-commit: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | use Config; 6 | # Hack to use carton's local::lib. 7 | use lib 'local/lib/perl5'; 8 | $ENV{PATH} .= $Config{path_sep}.'local/bin'; 9 | $ENV{PERL5LIB} = join $Config{path_sep}, 10 | grep defined, $ENV{PERL5LIB}, 'local/lib/perl5'; 11 | 12 | use Code::TidyAll::Git::Precommit; 13 | Code::TidyAll::Git::Precommit->check( no_stash => 1 ); 14 | -------------------------------------------------------------------------------- /git/setup.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | chmod +x git/hooks/pre-commit 4 | cd .git/hooks 5 | ln -s ../../git/hooks/pre-commit 6 | -------------------------------------------------------------------------------- /improve-search-results/.gitignore: -------------------------------------------------------------------------------- 1 | /local/ 2 | # carton/local::lib 3 | -------------------------------------------------------------------------------- /improve-search-results/README.md: -------------------------------------------------------------------------------- 1 | 2 | # Search result comparison system 3 | 4 | ## Why 5 | 6 | We want to improve MetaCPAN's search results, getting them at least as good as search.cpan.org's but ideally 7 | even better. 8 | 9 | ## How 10 | 11 | Run multiple searches (via the API that the web UI now uses), with different weights (that are now arguments) and compare to each other (so one weighthing doesn't 12 | then break another, or at least we can come to some 13 | balance). 14 | 15 | ### Installing 16 | 17 | You will need postgres installed with a database 18 | that matches the current user and the current user needs 19 | access (the MetaCPAN developer vm sets this up for you). 20 | 21 | ```sh 22 | cpanm Carton 23 | carton install 24 | ``` 25 | 26 | ### Running tests 27 | 28 | ```sh 29 | 30 | carton exec /opt/perl-5.22.2/bin/perl ./app.pl eval 'app->perform_all_searches' 31 | ``` 32 | 33 | ### Viewing results site 34 | ```sh 35 | carton exec /opt/perl-5.22.2/bin/perl ./app.pl daemon -m production -l http://*:5000 36 | ``` 37 | 38 | 39 | 40 | 41 | 42 | -------------------------------------------------------------------------------- /improve-search-results/cpanfile: -------------------------------------------------------------------------------- 1 | requires 'perl', '5.010'; 2 | 3 | requires 'Mojolicious', 7.23; 4 | requires 'Mojolicious::Lite', 0; 5 | requires 'Mojo::Pg', 2.35; 6 | 7 | -------------------------------------------------------------------------------- /lib/Catalyst/Action/Serialize/MetaCPANSanitizedJSON.pm: -------------------------------------------------------------------------------- 1 | package Catalyst::Action::Serialize::MetaCPANSanitizedJSON; 2 | 3 | use Moose; 4 | extends 'Catalyst::Action::Serialize::JSON'; 5 | 6 | __PACKAGE__->meta->make_immutable; 7 | 8 | 1; 9 | -------------------------------------------------------------------------------- /lib/ElasticSearchX/Model/Document/Role.pm: -------------------------------------------------------------------------------- 1 | package ElasticSearchX::Model::Document::Role; 2 | use strict; 3 | use warnings; 4 | 5 | use MetaCPAN::Model::Hacks; 6 | 7 | no warnings 'redefine'; 8 | 9 | my $_put = \&_put; 10 | *_put = sub { 11 | my ($self) = @_; 12 | my $es = $self->index->model->es; 13 | 14 | my %return = &$_put; 15 | 16 | if ( $es->api_version le '6_0' ) { 17 | return %return; 18 | } 19 | 20 | delete $return{type}; 21 | return %return; 22 | }; 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/MetaCPAN/API/Controller/Admin.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::API::Controller::Admin; 2 | 3 | use Mojo::Base 'Mojolicious::Controller'; 4 | 5 | sub identity_search_form { } 6 | 7 | sub search_identities { 8 | my $self = shift; 9 | my $data = $self->model->user->lookup( $self->param('name'), 10 | $self->param('key') ); 11 | $self->stash( user_data => $data ); 12 | $self->render('admin/search_identities'); 13 | } 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/MetaCPAN/API/Controller/Cover.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::API::Controller::Cover; 2 | 3 | use Mojo::Base 'Mojolicious::Controller'; 4 | 5 | sub lookup { 6 | my $c = shift; 7 | return unless $c->openapi->valid_input; 8 | my $args = $c->validation->output; 9 | 10 | my $results = $c->model->cover->find_release_coverage( $args->{name} ); 11 | return $c->render( openapi => $results ) if $results; 12 | $c->rendered(404); 13 | } 14 | 15 | 1; 16 | 17 | -------------------------------------------------------------------------------- /lib/MetaCPAN/API/Controller/Queue.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::API::Controller::Queue; 2 | 3 | use Mojo::Base 'Mojolicious::Controller'; 4 | 5 | my $rel 6 | = 'https://cpan.metacpan.org/authors/id/O/OA/OALDERS/HTML-Restrict-2.2.2.tar.gz'; 7 | 8 | sub enqueue { 9 | my $self = shift; 10 | $self->minion->enqueue( index_release => [ '--latest', $rel ] ); 11 | $self->render( text => 'OK' ); 12 | } 13 | 14 | sub index_release { 15 | my $self = shift; 16 | $self->render( text => 'ok' ); 17 | } 18 | 19 | 1; 20 | -------------------------------------------------------------------------------- /lib/MetaCPAN/API/Controller/Search.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::API::Controller::Search; 2 | 3 | use Mojo::Base 'Mojolicious::Controller'; 4 | 5 | sub first { 6 | my $c = shift; 7 | return unless $c->openapi->valid_input; 8 | my $args = $c->validation->output; 9 | 10 | my $results = $c->model->search->search_for_first_result( $args->{q} ); 11 | return $c->render( openapi => $results ) if $results; 12 | $c->rendered(404); 13 | } 14 | 15 | sub web { 16 | my $c = shift; 17 | return unless $c->openapi->valid_input; 18 | my $args = $c->validation->output; 19 | 20 | my $query = $args->{q}; 21 | my $size = $args->{page_size} // $args->{size} // 20; 22 | my $page = $args->{page} // ( 1 + int( ( $args->{from} // 0 ) / $size ) ); 23 | my $collapsed = $args->{collapsed}; 24 | 25 | my $results 26 | = $c->model->search->search_web( $query, $page, $size, $collapsed ); 27 | 28 | return $c->render( json => $results ); 29 | } 30 | 31 | 1; 32 | 33 | -------------------------------------------------------------------------------- /lib/MetaCPAN/API/Model/Cover.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::API::Model::Cover; 2 | 3 | use MetaCPAN::ESConfig qw( es_doc_path ); 4 | use MetaCPAN::Moose; 5 | 6 | use MetaCPAN::Util qw(hit_total); 7 | 8 | with 'MetaCPAN::API::Model::Role::ES'; 9 | 10 | sub find_release_coverage { 11 | my ( $self, $release ) = @_; 12 | 13 | my $query = +{ term => { release => $release } }; 14 | 15 | my $res = $self->_run_query( 16 | es_doc_path('cover'), 17 | body => { 18 | query => $query, 19 | size => 999, 20 | } 21 | ); 22 | hit_total($res) or return {}; 23 | 24 | return +{ 25 | %{ $res->{hits}{hits}[0]{_source} }, 26 | url => "http://cpancover.com/latest/$release/index.html", 27 | }; 28 | } 29 | 30 | __PACKAGE__->meta->make_immutable; 31 | 32 | 1; 33 | 34 | -------------------------------------------------------------------------------- /lib/MetaCPAN/API/Model/Download.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::API::Model::Download; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | with 'MetaCPAN::API::Model::Role::ES'; 6 | 7 | __PACKAGE__->meta->make_immutable; 8 | 9 | 1; 10 | 11 | -------------------------------------------------------------------------------- /lib/MetaCPAN/API/Model/Role/ES.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::API::Model::Role::ES; 2 | 3 | use Moose::Role; 4 | 5 | use MetaCPAN::Types::TypeTiny qw( Object ); 6 | 7 | has es => ( 8 | is => 'ro', 9 | isa => Object, 10 | handles => { _run_query => 'search', }, 11 | required => 1, 12 | ); 13 | 14 | no Moose::Role; 15 | 1; 16 | 17 | -------------------------------------------------------------------------------- /lib/MetaCPAN/API/Model/User.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::API::Model::User; 2 | 3 | use MetaCPAN::ESConfig qw( es_doc_path ); 4 | use MetaCPAN::Moose; 5 | 6 | with 'MetaCPAN::API::Model::Role::ES'; 7 | 8 | sub lookup { 9 | my ( $self, $name, $key ) = @_; 10 | 11 | my $query = { 12 | bool => { 13 | must => [ 14 | { term => { 'identity.name' => $name } }, 15 | { term => { 'identity.key' => $key } }, 16 | ] 17 | } 18 | }; 19 | 20 | my $res = $self->_run_query( 21 | es_doc_path('account'), 22 | body => { query => $query }, 23 | search_type => 'dfs_query_then_fetch', 24 | ); 25 | 26 | return $res->{hits}{hits}[0]{_source}; 27 | } 28 | 29 | __PACKAGE__->meta->make_immutable; 30 | 31 | 1; 32 | 33 | -------------------------------------------------------------------------------- /lib/MetaCPAN/API/Plugin/Model.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::API::Plugin::Model; 2 | 3 | use Mojo::Base 'Mojolicious::Plugin'; 4 | 5 | use Carp (); 6 | 7 | # Models from the catalyst app 8 | use MetaCPAN::Query::Search (); 9 | 10 | # New models 11 | use MetaCPAN::API::Model::Cover (); 12 | use MetaCPAN::API::Model::Download (); 13 | use MetaCPAN::API::Model::User (); 14 | 15 | has app => sub { Carp::croak 'app is required' }, weak => 1; 16 | 17 | has download => sub { 18 | my $self = shift; 19 | return MetaCPAN::API::Model::Download->new( es => $self->app->es ); 20 | }; 21 | 22 | has search => sub { 23 | my $self = shift; 24 | return MetaCPAN::Query::Search->new( es => $self->app->es, ); 25 | }; 26 | 27 | has user => sub { 28 | my $self = shift; 29 | return MetaCPAN::API::Model::User->new( es => $self->app->es ); 30 | }; 31 | 32 | has cover => sub { 33 | my $self = shift; 34 | return MetaCPAN::API::Model::Cover->new( es => $self->app->es ); 35 | }; 36 | 37 | sub register { 38 | my ( $plugin, $app, $conf ) = @_; 39 | $plugin->app($app); 40 | 41 | # cached models 42 | $app->helper( 'model.download' => sub { $plugin->download } ); 43 | $app->helper( 'model.search' => sub { $plugin->search } ); 44 | $app->helper( 'model.user' => sub { $plugin->user } ); 45 | $app->helper( 'model.cover' => sub { $plugin->cover } ); 46 | } 47 | 48 | 1; 49 | 50 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Document/Author/Profile.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Document::Author::Profile; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use ElasticSearchX::Model::Document; 8 | 9 | with 'ElasticSearchX::Model::Document::EmbeddedRole'; 10 | 11 | use MetaCPAN::Types::TypeTiny qw( Str ); 12 | use MetaCPAN::Util; 13 | 14 | has name => ( 15 | is => 'ro', 16 | isa => Str, 17 | required => 1, 18 | ); 19 | 20 | has id => ( 21 | is => 'ro', 22 | isa => Str, 23 | analyzer => ['simple'], 24 | ); 25 | 26 | __PACKAGE__->meta->make_immutable; 27 | 28 | 1; 29 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Document/CVE.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Document::CVE; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | use ElasticSearchX::Model::Document; 6 | use MetaCPAN::Types::TypeTiny qw( ArrayRef Str ); 7 | 8 | has distribution => ( 9 | is => 'ro', 10 | isa => Str, 11 | required => 1, 12 | ); 13 | 14 | has cpansa_id => ( 15 | is => 'ro', 16 | isa => Str, 17 | required => 1, 18 | ); 19 | 20 | has description => ( 21 | is => 'ro', 22 | isa => Str, 23 | required => 1, 24 | ); 25 | 26 | has severity => ( 27 | is => 'ro', 28 | isa => Str, 29 | required => 1, 30 | ); 31 | 32 | has reported => ( 33 | is => 'ro', 34 | isa => Str, 35 | required => 1, 36 | ); 37 | 38 | has affected_versions => ( 39 | is => 'ro', 40 | isa => ArrayRef, 41 | required => 1, 42 | ); 43 | 44 | has cves => ( 45 | is => 'ro', 46 | isa => ArrayRef, 47 | required => 1, 48 | ); 49 | 50 | has references => ( 51 | is => 'ro', 52 | isa => ArrayRef, 53 | required => 1, 54 | ); 55 | 56 | has versions => ( 57 | is => 'ro', 58 | isa => ArrayRef, 59 | required => 1, 60 | ); 61 | 62 | __PACKAGE__->meta->make_immutable; 63 | 1; 64 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Document/Contributor.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Document::Contributor; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | use ElasticSearchX::Model::Document; 6 | use MetaCPAN::Types::TypeTiny qw( ArrayRef Str ); 7 | 8 | has distribution => ( 9 | is => 'ro', 10 | isa => Str, 11 | required => 1, 12 | ); 13 | 14 | has release_author => ( 15 | is => 'ro', 16 | isa => Str, 17 | required => 1, 18 | ); 19 | 20 | has release_name => ( 21 | is => 'ro', 22 | isa => Str, 23 | required => 1, 24 | ); 25 | 26 | has pauseid => ( 27 | is => 'ro', 28 | isa => Str, 29 | ); 30 | 31 | has name => ( 32 | is => 'ro', 33 | isa => Str, 34 | ); 35 | 36 | has email => ( 37 | is => 'ro', 38 | isa => ArrayRef [Str], 39 | ); 40 | 41 | __PACKAGE__->meta->make_immutable; 42 | 1; 43 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Document/Cover.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Document::Cover; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | use ElasticSearchX::Model::Document; 6 | use MetaCPAN::Types::TypeTiny qw( HashRef Str ); 7 | 8 | has distribution => ( 9 | is => 'ro', 10 | isa => Str, 11 | required => 1, 12 | ); 13 | 14 | has release => ( 15 | is => 'ro', 16 | isa => Str, 17 | required => 1, 18 | ); 19 | 20 | has version => ( 21 | is => 'ro', 22 | isa => Str, 23 | required => 1, 24 | ); 25 | 26 | has criteria => ( 27 | is => 'ro', 28 | isa => HashRef, 29 | required => 1, 30 | ); 31 | 32 | __PACKAGE__->meta->make_immutable; 33 | 1; 34 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Document/Dependency.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Document::Dependency; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use ElasticSearchX::Model::Document; 8 | 9 | with 'ElasticSearchX::Model::Document::EmbeddedRole'; 10 | 11 | use MetaCPAN::Util; 12 | 13 | has [qw(phase relationship module version)] => ( is => 'ro', required => 1 ); 14 | 15 | __PACKAGE__->meta->make_immutable; 16 | 1; 17 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Document/Distribution.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Document::Distribution; 2 | 3 | use strict; 4 | use warnings; 5 | use namespace::autoclean; 6 | 7 | use Moose; 8 | use ElasticSearchX::Model::Document; 9 | 10 | use MetaCPAN::Types::TypeTiny qw( BugSummary RiverSummary ); 11 | use MetaCPAN::Util qw(true false); 12 | 13 | has name => ( 14 | is => 'ro', 15 | required => 1, 16 | id => 1, 17 | ); 18 | 19 | has bugs => ( 20 | is => 'ro', 21 | isa => BugSummary, 22 | dynamic => 1, 23 | writer => '_set_bugs', 24 | ); 25 | 26 | has river => ( 27 | is => 'ro', 28 | isa => RiverSummary, 29 | dynamic => 1, 30 | writer => '_set_river', 31 | default => sub { 32 | +{ 33 | bucket => 0, 34 | bus_factor => 1, 35 | immediate => 0, 36 | total => 0, 37 | }; 38 | }, 39 | ); 40 | 41 | sub releases { 42 | my $self = shift; 43 | return $self->index->model->doc("release") 44 | ->query( { term => { "distribution" => $self->name } } ); 45 | } 46 | 47 | sub set_first_release { 48 | my $self = shift; 49 | 50 | my @releases = $self->releases->sort( ["date"] )->all; 51 | 52 | my $first = shift @releases; 53 | $first->_set_first(true); 54 | $first->put; 55 | 56 | for my $rel (@releases) { 57 | $rel->_set_first(false); 58 | $rel->put; 59 | } 60 | 61 | return $first; 62 | } 63 | 64 | __PACKAGE__->meta->make_immutable; 65 | 66 | 1; 67 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Document/Favorite.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Document::Favorite; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use ElasticSearchX::Model::Document; 8 | 9 | use DateTime (); 10 | use MetaCPAN::Util; 11 | 12 | has id => ( 13 | is => 'ro', 14 | id => [qw(user distribution)], 15 | ); 16 | 17 | has [qw(author release user distribution)] => ( 18 | is => 'ro', 19 | required => 1, 20 | ); 21 | 22 | =head2 date 23 | 24 | L when the item was created. 25 | 26 | =cut 27 | 28 | has date => ( 29 | is => 'ro', 30 | required => 1, 31 | isa => 'DateTime', 32 | default => sub { DateTime->now }, 33 | ); 34 | 35 | __PACKAGE__->meta->make_immutable; 36 | 1; 37 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Document/Mirror.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Document::Mirror; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use MooseX::Types::ElasticSearch qw( Location ); 8 | use ElasticSearchX::Model::Document; 9 | 10 | use MetaCPAN::Types::TypeTiny qw( Dict Str ); 11 | 12 | has name => ( 13 | is => 'ro', 14 | required => 1, 15 | id => 1, 16 | ); 17 | 18 | has [qw(org city region country continent)] => ( 19 | is => 'ro', 20 | index => 'analyzed', 21 | ); 22 | 23 | has [qw(tz src http rsync ftp freq note dnsrr ccode aka_name A_or_CNAME)] => 24 | ( is => 'ro' ); 25 | 26 | has location => ( 27 | is => 'ro', 28 | isa => Location, 29 | coerce => 1, 30 | ); 31 | 32 | has contact => ( 33 | is => 'ro', 34 | required => 1, 35 | isa => Dict [ contact_site => Str, contact_user => Str ], 36 | ); 37 | 38 | has [qw(inceptdate reitredate)] => ( 39 | is => 'ro', 40 | isa => 'DateTime', 41 | coerce => 1, 42 | ); 43 | 44 | __PACKAGE__->meta->make_immutable; 45 | 1; 46 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Document/Package.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Document::Package; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | use ElasticSearchX::Model::Document; 6 | use MetaCPAN::Types::TypeTiny qw( Str ); 7 | 8 | has module_name => ( 9 | is => 'ro', 10 | isa => Str, 11 | required => 1, 12 | ); 13 | 14 | has version => ( 15 | is => 'ro', 16 | isa => Str, 17 | ); 18 | 19 | has file => ( 20 | is => 'ro', 21 | isa => Str, 22 | ); 23 | 24 | __PACKAGE__->meta->make_immutable; 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Document/Permission.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Document::Permission; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | use ElasticSearchX::Model::Document; 6 | use MetaCPAN::Types::TypeTiny qw( ArrayRef Str ); 7 | 8 | has module_name => ( 9 | is => 'ro', 10 | isa => Str, 11 | required => 1, 12 | ); 13 | 14 | has owner => ( 15 | is => 'ro', 16 | isa => Str, 17 | ); 18 | 19 | has co_maintainers => ( 20 | is => 'ro', 21 | isa => ArrayRef, 22 | ); 23 | 24 | __PACKAGE__->meta->make_immutable; 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Model.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Model; 2 | 3 | # load order important 4 | use Moose; 5 | 6 | use ElasticSearchX::Model; 7 | use MetaCPAN::ESConfig qw(es_config); 8 | use Module::Runtime qw(require_module use_package_optimistically); 9 | 10 | my %indexes; 11 | my $docs = es_config->documents; 12 | for my $name ( sort keys %$docs ) { 13 | my $doc = $docs->{$name}; 14 | my $model = $doc->{model} 15 | or next; 16 | require_module($model); 17 | use_package_optimistically( $model . '::Set' ); 18 | my $index = $doc->{index} 19 | or die "no index for $name documents!"; 20 | 21 | $indexes{$index}{types}{$name} = $model->meta; 22 | } 23 | 24 | for my $index ( sort keys %indexes ) { 25 | index $index => %{ $indexes{$index} }; 26 | } 27 | 28 | sub doc { 29 | my ( $self, $doc ) = @_; 30 | my $doc_config = es_config->documents->{$doc}; 31 | return $self->index( $doc_config->{index} ) 32 | ->type( $doc_config->{type} // $doc_config->{index} ); 33 | } 34 | 35 | __PACKAGE__->meta->make_immutable; 36 | 1; 37 | 38 | __END__ 39 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Model/ESWrapper.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Model::ESWrapper; 2 | use strict; 3 | use warnings; 4 | 5 | use MetaCPAN::Types::TypeTiny qw(ES); 6 | 7 | sub new { 8 | my ( $class, $es ) = @_; 9 | if ( $es->api_version le '6_0' ) { 10 | return $es; 11 | } 12 | return bless { es => ES->assert_coerce($es) }, $class; 13 | } 14 | 15 | sub DESTROY { } 16 | 17 | sub AUTOLOAD { 18 | my $sub = our $AUTOLOAD =~ s/.*:://r; 19 | my $self = shift; 20 | $self->{es}->$sub(@_); 21 | } 22 | 23 | sub _args { 24 | my $self = shift; 25 | if ( @_ == 1 ) { 26 | return ( $self, %{ $_[0] } ); 27 | } 28 | return ( $self, @_ ); 29 | } 30 | 31 | sub count { 32 | my ( $self, %args ) = &_args; 33 | delete $args{type}; 34 | $self->{es}->count(%args); 35 | } 36 | 37 | sub get { 38 | my ( $self, %args ) = &_args; 39 | delete $args{type}; 40 | $self->{es}->get(%args); 41 | } 42 | 43 | sub delete { 44 | my ( $self, %args ) = &_args; 45 | delete $args{type}; 46 | $self->{es}->delete(%args); 47 | } 48 | 49 | sub search { 50 | my ( $self, %args ) = &_args; 51 | delete $args{type}; 52 | $self->{es}->search(%args); 53 | } 54 | 55 | sub scroll_helper { 56 | my ( $self, %args ) = &_args; 57 | delete $args{type}; 58 | $self->{es}->scroll_helper(%args); 59 | } 60 | 61 | 1; 62 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Model/Hacks.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Model::Hacks; 2 | use strict; 3 | use warnings; 4 | 5 | sub import { 6 | my ( $caller, $caller_file ) = caller; 7 | 8 | my $file = $caller =~ s{::}{/}gr . '.pm'; 9 | my $dir = $caller_file =~ s{/\Q$file\E\z}{}r; 10 | local @INC = grep $_ ne $dir, @INC; 11 | my $inc; 12 | { 13 | local $INC{$file}; 14 | delete $INC{$file}; 15 | require $file; 16 | $inc = $INC{$file}; 17 | } 18 | delete $INC{$file}; 19 | $INC{$file} = $inc; 20 | return; 21 | } 22 | 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Model/User/Account/Set.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Model::User::Account::Set; 2 | 3 | use Moose; 4 | extends 'ElasticSearchX::Model::Document::Set'; 5 | 6 | =head1 SET METHODS 7 | 8 | =head2 find 9 | 10 | $type->find({ name => "github", key => 123455 }); 11 | 12 | Find an account based on its identity. 13 | 14 | =cut 15 | 16 | sub find { 17 | my ( $self, $p ) = @_; 18 | return $self->query( { 19 | bool => { 20 | must => [ 21 | { term => { 'identity.name' => $p->{name} } }, 22 | { term => { 'identity.key' => $p->{key} } }, 23 | ], 24 | } 25 | } )->first; 26 | } 27 | 28 | =head2 find_code 29 | 30 | $type->find_code($code); 31 | 32 | Find account by C<$code>. See L. 33 | 34 | =cut 35 | 36 | sub find_code { 37 | my ( $self, $token ) = @_; 38 | return $self->query( { term => { code => $token } } )->first; 39 | } 40 | 41 | =head2 find_token 42 | 43 | $type->find_token($access_token); 44 | 45 | Find account by C<$access_token>. See L. 46 | 47 | =cut 48 | 49 | sub find_token { 50 | my ( $self, $token ) = @_; 51 | return $self->query( { term => { 'access_token.token' => $token } } ) 52 | ->first; 53 | } 54 | 55 | __PACKAGE__->meta->make_immutable; 56 | 1; 57 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Model/User/Identity.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Model::User::Identity; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use ElasticSearchX::Model::Document; 8 | use MetaCPAN::Types::TypeTiny qw( HashRef ); 9 | 10 | has name => ( 11 | is => 'ro', 12 | required => 1, 13 | ); 14 | 15 | has key => ( is => 'ro' ); 16 | 17 | has extra => ( 18 | is => 'ro', 19 | isa => HashRef, 20 | source_only => 1, 21 | dynamic => 1, 22 | ); 23 | 24 | __PACKAGE__->meta->make_immutable; 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Model/User/Session.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Model::User::Session; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use ElasticSearchX::Model::Document; 8 | 9 | __PACKAGE__->meta->make_immutable; 10 | 1; 11 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Query.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Query; 2 | use Moose; 3 | 4 | use Module::Runtime qw( require_module ); 5 | use Module::Pluggable::Object (); 6 | use MetaCPAN::Types::TypeTiny qw( ES ); 7 | 8 | has es => ( 9 | is => 'ro', 10 | required => 1, 11 | isa => ES, 12 | coerce => 1, 13 | ); 14 | 15 | my @plugins = Module::Pluggable::Object->new( 16 | search_path => [__PACKAGE__], 17 | max_depth => 3, 18 | require => 0, 19 | )->plugins; 20 | 21 | for my $class (@plugins) { 22 | require_module($class); 23 | my $name = $class->can('name') && $class->name 24 | or next; 25 | 26 | my $in = "_in_$name"; 27 | my $gen = "_gen_$name"; 28 | 29 | has $in => ( 30 | is => 'ro', 31 | init_arg => $name, 32 | weak_ref => 1, 33 | ); 34 | 35 | has $gen => ( 36 | is => 'ro', 37 | init_arg => undef, 38 | lazy => 1, 39 | default => sub { 40 | my $self = shift; 41 | $class->new( 42 | es => $self->es, 43 | query => $self, 44 | ); 45 | }, 46 | ); 47 | 48 | no strict 'refs'; 49 | *$name = sub { $_[0]->$in // $_[0]->$gen }; 50 | } 51 | 52 | 1; 53 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Query/CVE.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Query::CVE; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | use MetaCPAN::ESConfig qw( es_doc_path ); 6 | 7 | with 'MetaCPAN::Query::Role::Common'; 8 | 9 | sub find_cves_by_cpansa { 10 | my ( $self, $cpansa_id ) = @_; 11 | 12 | my $query = +{ term => { cpansa_id => $cpansa_id } }; 13 | 14 | my $res = $self->es->search( 15 | es_doc_path('cve'), 16 | body => { 17 | query => $query, 18 | size => 999, 19 | } 20 | ); 21 | 22 | return +{ cve => [ map { $_->{_source} } @{ $res->{hits}{hits} } ] }; 23 | } 24 | 25 | sub find_cves_by_release { 26 | my ( $self, $author, $release ) = @_; 27 | 28 | my $query = +{ match => { releases => "$author/$release" } }; 29 | 30 | my $res = $self->es->search( 31 | es_doc_path('cve'), 32 | body => { 33 | query => $query, 34 | size => 999, 35 | } 36 | ); 37 | 38 | return +{ cve => [ map { $_->{_source} } @{ $res->{hits}{hits} } ] }; 39 | } 40 | 41 | sub find_cves_by_dist { 42 | my ( $self, $dist, $version ) = @_; 43 | 44 | my $query = +{ 45 | match => { 46 | dist => $dist, 47 | ( defined $version ? ( versions => $version ) : () ), 48 | } 49 | }; 50 | 51 | my $res = $self->es->search( 52 | es_doc_path('cve'), 53 | body => { 54 | query => $query, 55 | size => 999, 56 | } 57 | ); 58 | 59 | return +{ cve => [ map { $_->{_source} } @{ $res->{hits}{hits} } ] }; 60 | } 61 | 62 | __PACKAGE__->meta->make_immutable; 63 | 1; 64 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Query/Cover.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Query::Cover; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | use MetaCPAN::ESConfig qw( es_doc_path ); 6 | use MetaCPAN::Util qw(hit_total); 7 | 8 | with 'MetaCPAN::Query::Role::Common'; 9 | 10 | sub find_release_coverage { 11 | my ( $self, $release ) = @_; 12 | 13 | my $query = +{ term => { release => $release } }; 14 | 15 | my $res = $self->es->search( 16 | es_doc_path('cover'), 17 | body => { 18 | query => $query, 19 | size => 999, 20 | } 21 | ); 22 | hit_total($res) or return {}; 23 | 24 | return +{ 25 | %{ $res->{hits}{hits}[0]{_source} }, 26 | url => "http://cpancover.com/latest/$release/index.html", 27 | }; 28 | } 29 | 30 | __PACKAGE__->meta->make_immutable; 31 | 1; 32 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Query/Distribution.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Query::Distribution; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | use MetaCPAN::ESConfig qw( es_doc_path ); 6 | use MetaCPAN::Util qw(hit_total); 7 | 8 | with 'MetaCPAN::Query::Role::Common'; 9 | 10 | sub rogue_list { 11 | return qw( 12 | Acme-DependOnEverything 13 | Bundle-Everything 14 | kurila 15 | perl-5.005_02+apache1.3.3+modperl 16 | perlbench 17 | perl_debug 18 | perl_mlb 19 | pod2texi 20 | spodcxx 21 | ); 22 | } 23 | 24 | sub get_river_data_by_dist { 25 | my ( $self, $dist ) = @_; 26 | 27 | my $query = +{ 28 | bool => { 29 | must => [ { term => { name => $dist } }, ] 30 | } 31 | }; 32 | 33 | my $res = $self->es->search( 34 | es_doc_path('distribution'), 35 | body => { 36 | query => $query, 37 | size => 999, 38 | } 39 | ); 40 | hit_total($res) or return {}; 41 | 42 | return +{ river => +{ $dist => $res->{hits}{hits}[0]{_source}{river} } }; 43 | } 44 | 45 | sub get_river_data_by_dists { 46 | my ( $self, $dist ) = @_; 47 | 48 | my $query = +{ 49 | bool => { 50 | must => [ { terms => { name => $dist } }, ] 51 | } 52 | }; 53 | 54 | my $res = $self->es->search( 55 | es_doc_path('distribution'), 56 | body => { 57 | query => $query, 58 | size => 999, 59 | } 60 | ); 61 | hit_total($res) or return {}; 62 | 63 | return +{ 64 | river => +{ 65 | map { $_->{_source}{name} => $_->{_source}{river} } 66 | @{ $res->{hits}{hits} } 67 | }, 68 | }; 69 | } 70 | 71 | __PACKAGE__->meta->make_immutable; 72 | 1; 73 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Query/Package.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Query::Package; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | use MetaCPAN::ESConfig qw( es_doc_path ); 6 | 7 | with 'MetaCPAN::Query::Role::Common'; 8 | 9 | sub get_modules { 10 | my ( $self, $dist, $ver ) = @_; 11 | 12 | my $query = +{ 13 | bool => { 14 | must => [ 15 | { term => { distribution => $dist } }, 16 | { term => { dist_version => $ver } }, 17 | ], 18 | } 19 | }; 20 | 21 | my $res = $self->es->search( 22 | es_doc_path('package'), 23 | body => { 24 | query => $query, 25 | size => 999, 26 | _source => [qw< module_name >], 27 | } 28 | ); 29 | 30 | return +{ modules => 31 | [ map { $_->{_source}{module_name} } @{ $res->{hits}{hits} } ] }; 32 | } 33 | 34 | __PACKAGE__->meta->make_immutable; 35 | 1; 36 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Query/Permission.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Query::Permission; 2 | 3 | use MetaCPAN::Moose; 4 | 5 | use MetaCPAN::ESConfig qw( es_doc_path ); 6 | use Ref::Util qw( is_arrayref ); 7 | 8 | with 'MetaCPAN::Query::Role::Common'; 9 | 10 | sub by_author { 11 | my ( $self, $pauseid ) = @_; 12 | 13 | my $body = { 14 | query => { 15 | bool => { 16 | should => [ 17 | { term => { owner => $pauseid } }, 18 | { term => { co_maintainers => $pauseid } }, 19 | ], 20 | }, 21 | }, 22 | size => 5_000, 23 | }; 24 | 25 | my $ret = $self->es->search( es_doc_path('permission'), body => $body, ); 26 | 27 | my $data = [ 28 | sort { $a->{module_name} cmp $b->{module_name} } 29 | map { $_->{_source} } @{ $ret->{hits}{hits} } 30 | ]; 31 | 32 | return { permissions => $data }; 33 | } 34 | 35 | sub by_modules { 36 | my ( $self, $modules ) = @_; 37 | $modules = [$modules] unless is_arrayref($modules); 38 | 39 | my @modules = map +{ term => { module_name => $_ } }, 40 | grep defined, @{$modules}; 41 | return { permissions => [] } 42 | unless @modules; 43 | 44 | my $body = { 45 | query => { 46 | bool => { should => \@modules } 47 | }, 48 | size => 1_000, 49 | }; 50 | 51 | my $ret = $self->es->search( es_doc_path('permission'), body => $body, ); 52 | 53 | my $data = [ 54 | sort { $a->{module_name} cmp $b->{module_name} } 55 | map { $_->{_source} } @{ $ret->{hits}{hits} } 56 | ]; 57 | 58 | return { permissions => $data }; 59 | } 60 | 61 | __PACKAGE__->meta->make_immutable; 62 | 1; 63 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Query/Role/Common.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Query::Role::Common; 2 | use Moose::Role; 3 | 4 | use MetaCPAN::Types::TypeTiny qw( ES ); 5 | 6 | has es => ( 7 | is => 'ro', 8 | required => 1, 9 | isa => ES, 10 | coerce => 1, 11 | ); 12 | 13 | sub name { 14 | my $self = shift; 15 | my $class = ref $self || $self; 16 | 17 | $class =~ /^MetaCPAN::Query::([^:]+)$/ 18 | or return undef; 19 | return lc $1; 20 | } 21 | 22 | has _in_query => ( 23 | is => 'ro', 24 | init_arg => 'query', 25 | weak_ref => 1, 26 | ); 27 | 28 | has _gen_query => ( 29 | is => 'ro', 30 | lazy => 1, 31 | init_arg => undef, 32 | default => sub { 33 | my $self = shift; 34 | my $name = $self->name; 35 | 36 | require MetaCPAN::Query; 37 | MetaCPAN::Query->new( 38 | es => $self->es, 39 | ( $name ? ( $name => $self ) : () ), 40 | ); 41 | }, 42 | ); 43 | 44 | sub query { $_[0]->_in_query // $_[0]->_gen_query } 45 | 46 | 1; 47 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Role/HasConfig.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Role::HasConfig; 2 | 3 | use Moose::Role; 4 | 5 | use MetaCPAN::Server::Config (); 6 | use MetaCPAN::Types::TypeTiny qw( HashRef ); 7 | 8 | # Done like this so can be required by a role 9 | sub config { 10 | return $_[0]->_config; 11 | } 12 | 13 | has _config => ( 14 | is => 'ro', 15 | isa => HashRef, 16 | lazy => 1, 17 | builder => '_build_config', 18 | ); 19 | 20 | sub _build_config { 21 | my $self = shift; 22 | return MetaCPAN::Server::Config::config(); 23 | } 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Role/HasRogueDistributions.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Role::HasRogueDistributions; 2 | 3 | use Moose::Role; 4 | 5 | use MetaCPAN::Types::TypeTiny qw( ArrayRef ); 6 | 7 | has rogue_distributions => ( 8 | is => 'ro', 9 | isa => ArrayRef, 10 | default => sub { 11 | [ qw( 12 | Bundle-Everything 13 | kurila 14 | perl-5.005_02+apache1.3.3+modperl 15 | perlbench 16 | perl_debug 17 | perl_mlb 18 | pod2texi 19 | spodcxx 20 | ) ]; 21 | }, 22 | ); 23 | 24 | no Moose::Role; 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Script/Queue.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Script::Queue; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use MetaCPAN::Types::TypeTiny qw( Path ); 7 | use Moose; 8 | use Path::Iterator::Rule (); 9 | 10 | has dir => ( 11 | is => 'ro', 12 | isa => Path, 13 | predicate => '_has_dir', 14 | coerce => 1, 15 | ); 16 | 17 | has file => ( 18 | is => 'ro', 19 | isa => Path, 20 | predicate => '_has_file', 21 | coerce => 1, 22 | ); 23 | 24 | with 'MetaCPAN::Role::Script', 'MooseX::Getopt'; 25 | 26 | sub run { 27 | my $self = shift; 28 | 29 | if ( $self->_has_dir ) { 30 | my $rule = Path::Iterator::Rule->new; 31 | $rule->name(qr{\.(tgz|tbz|tar[\._-]gz|tar\.bz2|tar\.Z|zip|7z)\z}); 32 | 33 | my $next = $rule->iter( $self->dir ); 34 | while ( defined( my $file = $next->() ) ) { 35 | $self->_add_to_queue( 36 | index_release => [$file], 37 | { attempts => 3 } 38 | ); 39 | } 40 | } 41 | 42 | if ( $self->_has_file ) { 43 | $self->_add_to_queue( 44 | index_release => [ $self->file->stringify ], 45 | { attempts => 3 } 46 | ); 47 | } 48 | } 49 | 50 | __PACKAGE__->meta->make_immutable; 51 | 1; 52 | __END__ 53 | 54 | =head1 SYNOPSIS 55 | 56 | bin/metacpan queue --file https://cpan.metacpan.org/authors/id/O/OA/OALDERS/HTML-Restrict-2.2.2.tar.gz 57 | bin/metacpan queue --dir /home/metacpan/CPAN/ 58 | bin/metacpan queue --dir /home/metacpan/CPAN/authors/id 59 | bin/metacpan queue --dir /home/metacpan/CPAN/authors/id/R/RW/RWSTAUNER 60 | bin/metacpan queue --file /home/metacpan/CPAN/authors/id/R/RW/RWSTAUNER/Timer-Simple-1.006.tar.gz 61 | 62 | =cut 63 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Script/Restart.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Script::Restart; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | with 'MetaCPAN::Role::Script', 'MooseX::Getopt'; 9 | 10 | sub run { 11 | shift->es->restart( 12 | 13 | # nodes => multi, 14 | delay => '5s' # optional 15 | ); 16 | } 17 | 18 | __PACKAGE__->meta->make_immutable; 19 | 1; 20 | 21 | __END__ 22 | 23 | =head1 SYNOPSIS 24 | 25 | # bin/metacpan restart 26 | 27 | =cut 28 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Script/Session.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Script::Session; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | use DateTime (); 9 | use MetaCPAN::ESConfig qw( es_doc_path ); 10 | 11 | with 'MetaCPAN::Role::Script', 'MooseX::Getopt'; 12 | 13 | sub run { 14 | my $self = shift; 15 | 16 | my $scroll = $self->es->scroll_helper( 17 | size => 10_000, 18 | scroll => '1m', 19 | es_doc_path('session'), 20 | ); 21 | 22 | my $bulk = $self->es->bulk_helper( es_doc_path('session'), 23 | max_count => 10_000 ); 24 | 25 | my $cutoff = DateTime->now->subtract( months => 1 )->epoch; 26 | 27 | while ( my $search = $scroll->next ) { 28 | 29 | if ( $search->{_source}->{__updated} < $cutoff ) { 30 | $bulk->delete( { id => $search->{_id} } ); 31 | } 32 | 33 | } 34 | 35 | $bulk->flush; 36 | 37 | } 38 | 39 | __PACKAGE__->meta->make_immutable; 40 | 1; 41 | 42 | =pod 43 | 44 | Purges user sessions. we iterate over the sessions for the time being and 45 | perform bulk delete. 46 | 47 | =cut 48 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Action/Deserialize.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Action::Deserialize; 2 | use Moose; 3 | extends 'Catalyst::Action::Deserialize'; 4 | 5 | around serialize_bad_request => sub { 6 | my $orig = shift; 7 | my $self = shift; 8 | my ( $c, $content_type, $error ) = @_; 9 | 10 | $c->res->status(400); 11 | 12 | my $full_error 13 | = "Content-Type $content_type had a problem with your request.\n$error"; 14 | $full_error =~ s{ at .*? line \d+\.\n\z}{}; 15 | 16 | $c->stash( { 17 | rest => { 18 | error => $full_error, 19 | }, 20 | } ); 21 | 22 | return undef; 23 | }; 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Config.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Config; 2 | 3 | use warnings; 4 | use strict; 5 | 6 | use Config::ZOMG (); 7 | use MetaCPAN::Util qw(root_dir); 8 | 9 | sub config { 10 | my $root = root_dir(); 11 | my $config = _zomg($root); 12 | 13 | if ( !$config ) { 14 | die "Couldn't find config file in $root"; 15 | } 16 | 17 | return $config; 18 | } 19 | 20 | sub _zomg { 21 | my $path = shift; 22 | 23 | my $config = Config::ZOMG->new( 24 | name => 'metacpan_server' 25 | . ( $ENV{HARNESS_ACTIVE} ? '_testing' : '' ), 26 | path => $path, 27 | ); 28 | 29 | my $c = $config->open; 30 | if ( defined $c->{logger} && ref $c->{logger} ne 'ARRAY' ) { 31 | $c->{logger} = [ $c->{logger} ]; 32 | } 33 | return keys %{$c} ? $c : undef; 34 | } 35 | 36 | 1; 37 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Activity.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Activity; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | with 'MetaCPAN::Server::Role::JSONP'; 11 | 12 | sub get : Path('') : Args(0) { 13 | my ( $self, $c ) = @_; 14 | 15 | $c->stash_or_detach( 16 | $c->model('ESQuery')->release->activity( $c->req->params ) ); 17 | } 18 | 19 | __PACKAGE__->meta->make_immutable; 20 | 1; 21 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/CVE.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::CVE; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | with 'MetaCPAN::Server::Role::JSONP'; 11 | 12 | sub get : Path('') : Args(1) { 13 | my ( $self, $c, $cpansa_id ) = @_; 14 | $c->stash_or_detach( 15 | $c->model('ESQuery')->cve->find_cves_by_cpansa($cpansa_id) ); 16 | } 17 | 18 | sub release : Path('release') : Args(2) { 19 | my ( $self, $c, $author, $release ) = @_; 20 | $c->stash_or_detach( 21 | $c->model('ESQuery')->cve->find_cves_by_release( $author, $release ) 22 | ); 23 | } 24 | 25 | sub dist : Path('dist') : Args(1) { 26 | my ( $self, $c, $dist ) = @_; 27 | my $version = $c->req->query_params->{version}; 28 | $c->stash_or_detach( 29 | $c->model('ESQuery')->cve->find_cves_by_dist( $dist, $version ) ); 30 | } 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Contributor.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Contributor; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | with 'MetaCPAN::Server::Role::JSONP'; 11 | 12 | sub get : Path('') : Args(2) { 13 | my ( $self, $c, $author, $name ) = @_; 14 | $c->stash_or_detach( $c->model('ESQuery') 15 | ->contributor->find_release_contributors( $author, $name ) ); 16 | } 17 | 18 | sub by_pauseid : Path('by_pauseid') : Args(1) { 19 | my ( $self, $c, $pauseid ) = @_; 20 | $c->stash_or_detach( 21 | $c->model('ESQuery')->contributor->find_author_contributions($pauseid) 22 | ); 23 | } 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Cover.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Cover; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | with 'MetaCPAN::Server::Role::JSONP'; 11 | 12 | sub get : Path('') : Args(1) { 13 | my ( $self, $c, $release ) = @_; 14 | $c->stash_or_detach( 15 | $c->model('ESQuery')->cover->find_release_coverage($release) ); 16 | } 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Distribution.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Distribution; 2 | 3 | use strict; 4 | use warnings; 5 | use namespace::autoclean; 6 | 7 | use Moose; 8 | 9 | BEGIN { extends 'MetaCPAN::Server::Controller' } 10 | 11 | with 'MetaCPAN::Server::Role::JSONP'; 12 | 13 | sub river_data_by_dist : Path('river') : Args(1) { 14 | my ( $self, $c, $dist ) = @_; 15 | $c->stash_or_detach( 16 | $c->model('ESQuery')->distribution->get_river_data_by_dist($dist) ); 17 | } 18 | 19 | sub river_data_by_dists : Path('river') : Args(0) { 20 | my ( $self, $c ) = @_; 21 | $c->stash_or_detach( 22 | $c->model('ESQuery')->distribution->get_river_data_by_dists( 23 | $c->read_param('distribution') 24 | ) 25 | ); 26 | } 27 | 28 | __PACKAGE__->meta->make_immutable; 29 | 1; 30 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/File.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::File; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use MetaCPAN::Util qw( single_valued_arrayref_to_scalar ); 8 | 9 | BEGIN { extends 'MetaCPAN::Server::Controller' } 10 | 11 | with 'MetaCPAN::Server::Role::JSONP'; 12 | 13 | sub find : Path('') { 14 | my ( $self, $c, $author, $release, @path ) = @_; 15 | 16 | $c->add_author_key($author); 17 | $c->cdn_max_age('1y'); 18 | 19 | eval { 20 | my $file = $self->model($c)->raw->get( { 21 | author => $author, 22 | release => $release, 23 | path => join( '/', @path ) 24 | } ); 25 | if ( $file->{_source} || $file->{fields} ) { 26 | $c->stash( $file->{_source} 27 | || single_valued_arrayref_to_scalar( $file->{fields} ) ); 28 | } 29 | } or $c->detach( '/not_found', [$@] ); 30 | } 31 | 32 | sub dir : Path('dir') { 33 | my ( $self, $c, @path ) = @_; 34 | $c->stash_or_detach( $c->model('ESQuery')->file->dir(@path) ); 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Mirror.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Mirror; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | with 'MetaCPAN::Server::Role::JSONP'; 11 | 12 | sub search : Path('search') : Args(0) { 13 | my ( $self, $c ) = @_; 14 | $c->stash_or_detach( 15 | $c->model('ESQuery')->mirror->search( $c->req->param('q') ) ); 16 | } 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Module.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Module; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use MetaCPAN::Util qw( single_valued_arrayref_to_scalar ); 8 | 9 | BEGIN { extends 'MetaCPAN::Server::Controller::File' } 10 | 11 | has '+type' => ( default => 'file' ); 12 | 13 | sub get : Path('') : Args(1) { 14 | my ( $self, $c, $name ) = @_; 15 | my $file 16 | = $c->model('ESQuery')->file->find_module( $name, $c->req->fields ); 17 | if ( !defined $file ) { 18 | $c->detach( '/not_found', [] ); 19 | } 20 | $c->stash($file); 21 | } 22 | 23 | __PACKAGE__->meta->make_immutable(); 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Package.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Package; 2 | 3 | use Moose; 4 | use namespace::autoclean; 5 | 6 | BEGIN { extends 'MetaCPAN::Server::Controller' } 7 | 8 | with 'MetaCPAN::Server::Role::JSONP'; 9 | 10 | # https://fastapi.metacpan.org/v1/package/modules/Moose 11 | sub modules : Path('modules') : Args(1) { 12 | my ( $self, $c, $dist ) = @_; 13 | 14 | my $last = $c->model('ESQuery')->release->find($dist); 15 | $c->detach( '/not_found', ["Cannot find last release for $dist"] ) 16 | unless $last; 17 | $c->stash_or_detach( 18 | $c->model('ESQuery')->package->get_modules( $dist, $last->{version} ) 19 | ); 20 | } 21 | 22 | __PACKAGE__->meta->make_immutable; 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Permission.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Permission; 2 | 3 | use Moose; 4 | use namespace::autoclean; 5 | 6 | BEGIN { extends 'MetaCPAN::Server::Controller' } 7 | 8 | with 'MetaCPAN::Server::Role::JSONP'; 9 | 10 | sub by_author : Path('by_author') : Args(1) { 11 | my ( $self, $c, $pauseid ) = @_; 12 | $c->stash_or_detach( 13 | $c->model('ESQuery')->permission->by_author($pauseid) ); 14 | } 15 | 16 | sub by_module : Path('by_module') : Args(1) { 17 | my ( $self, $c, $module ) = @_; 18 | $c->stash_or_detach( 19 | $c->model('ESQuery')->permission->by_modules($module) ); 20 | } 21 | 22 | sub by_modules : Path('by_module') : Args(0) { 23 | my ( $self, $c ) = @_; 24 | $c->stash_or_detach( $c->model('ESQuery') 25 | ->permission->by_modules( $c->read_param('module') ) ); 26 | } 27 | 28 | __PACKAGE__->meta->make_immutable; 29 | 1; 30 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/ReverseDependencies.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::ReverseDependencies; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | __PACKAGE__->config( namespace => 'reverse_dependencies' ); 11 | 12 | with 'MetaCPAN::Server::Role::JSONP'; 13 | 14 | sub dist : Path('dist') : Args(1) { 15 | my ( $self, $c, $dist ) = @_; 16 | $c->stash_or_detach( 17 | $c->model('ESQuery')->release->reverse_dependencies( 18 | $dist, @{ $c->req->params }{qw< page page_size sort >} 19 | ) 20 | ); 21 | } 22 | 23 | sub module : Path('module') : Args(1) { 24 | my ( $self, $c, $module ) = @_; 25 | $c->stash_or_detach( 26 | $c->model('ESQuery')->release->requires( 27 | $module, @{ $c->req->params }{qw< page page_size sort >} 28 | ) 29 | ); 30 | } 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Search.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Search; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | with 'MetaCPAN::Server::Role::JSONP'; 11 | 12 | sub index : Chained('/') : PathPart('search') : CaptureArgs(0) { 13 | } 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Search/Autocomplete.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Search::Autocomplete; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | with 'MetaCPAN::Server::Role::JSONP'; 11 | 12 | has '+type' => ( default => 'file' ); 13 | 14 | sub get : Local : Path('') : Args(0) { 15 | my ( $self, $c ) = @_; 16 | $c->stash_or_detach( 17 | $c->model('ESQuery')->file->autocomplete( $c->req->param("q") ) ); 18 | } 19 | 20 | sub suggest : Local : Path('/suggest') : Args(0) { 21 | my ( $self, $c ) = @_; 22 | $c->stash_or_detach( $c->model('ESQuery') 23 | ->file->autocomplete_suggester( $c->req->param("q") ) ); 24 | } 25 | 26 | 1; 27 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Search/DownloadURL.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Search::DownloadURL; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | with 'MetaCPAN::Server::Role::JSONP'; 11 | 12 | has '+type' => ( default => 'file' ); 13 | 14 | sub get : Local : Path('/download_url') : Args(1) { 15 | my ( $self, $c, $module ) = @_; 16 | my $type = $module eq 'perl' ? 'dist' : 'module'; 17 | my $data 18 | = $c->model('ESQuery') 19 | ->release->find_download_url( $type, $module, $c->req->params ); 20 | return $c->detach( '/not_found', [] ) unless $data; 21 | $c->stash($data); 22 | } 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Search/History.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Search::History; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | with 'MetaCPAN::Server::Role::JSONP'; 11 | 12 | has '+type' => ( default => 'file' ); 13 | 14 | sub get : Local : Path('') : Args { 15 | my ( $self, $c, $type, $name, @path ) = @_; 16 | my $fields = $c->res->fields; 17 | my $data = $c->model('ESQuery') 18 | ->file->history( $type, $name, \@path, { fields => $fields } ); 19 | $c->stash($data); 20 | } 21 | 22 | 1; 23 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Search/Web.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Search::Web; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | BEGIN { extends 'MetaCPAN::Server::Controller' } 9 | 10 | with 'MetaCPAN::Server::Role::JSONP'; 11 | 12 | # Kill default actions provided by our stupid Controller base class 13 | sub get { } 14 | sub all { } 15 | 16 | # returns the contents of the first result of a query 17 | sub first : Chained('/search/index') : PathPart('first') : Args(0) { 18 | my ( $self, $c ) = @_; 19 | my $args = $c->req->params; 20 | 21 | my $model = $c->model('Search'); 22 | my $results = $model->search_for_first_result( $args->{q} ); 23 | 24 | $c->stash_or_detach($results); 25 | } 26 | 27 | # The web endpoint is the primary one, this handles the front-end's user-facing search 28 | 29 | sub web : Chained('/search/index') : PathPart('web') : Args(0) { 30 | my ( $self, $c ) = @_; 31 | my $args = $c->req->params; 32 | 33 | my $query = $args->{q}; 34 | my $size = $args->{page_size} // $args->{size} // 20; 35 | my $page = $args->{page} // ( 1 + int( ( $args->{from} // 0 ) / $size ) ); 36 | my $collapsed = $args->{collapsed}; 37 | 38 | my $model = $c->model('Search'); 39 | my $results = $model->search_web( $query, $page, $size, $collapsed ); 40 | 41 | $c->stash($results); 42 | } 43 | 44 | 1; 45 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Model/ES.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Model::ES; 2 | 3 | use Moose; 4 | 5 | use MetaCPAN::Server::Config (); 6 | use MetaCPAN::Types::TypeTiny qw( ES ); 7 | 8 | extends 'Catalyst::Model'; 9 | 10 | has es => ( 11 | is => 'ro', 12 | isa => ES, 13 | coerce => 1, 14 | lazy => 1, 15 | default => sub { 16 | MetaCPAN::Server::Config::config()->{elasticsearch_servers}; 17 | }, 18 | ); 19 | 20 | sub ACCEPT_CONTEXT { 21 | my ( $self, $c ) = @_; 22 | return $self->es; 23 | } 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Model/ESModel.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Model::ESModel; 2 | 3 | use Moose; 4 | 5 | use MetaCPAN::Model (); 6 | use MetaCPAN::Model::ESWrapper (); 7 | 8 | extends 'Catalyst::Model'; 9 | 10 | has es => ( 11 | is => 'ro', 12 | writer => '_set_es', 13 | ); 14 | 15 | has _esx_model => ( 16 | is => 'ro', 17 | lazy => 1, 18 | default => sub { 19 | my $self = shift; 20 | my $es = MetaCPAN::Model::ESWrapper->new( $self->es ); 21 | MetaCPAN::Model->new( es => $es ); 22 | }, 23 | ); 24 | 25 | sub ACCEPT_CONTEXT { 26 | my ( $self, $c ) = @_; 27 | if ( !$self->es ) { 28 | $self->_set_es( $c->model('ES') ); 29 | } 30 | return $self->_esx_model; 31 | } 32 | 33 | 1; 34 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Model/ESQuery.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Model::ESQuery; 2 | 3 | use Moose; 4 | 5 | use MetaCPAN::Query (); 6 | 7 | extends 'Catalyst::Model'; 8 | 9 | has es => ( 10 | is => 'ro', 11 | writer => '_set_es', 12 | ); 13 | 14 | has _esx_query => ( 15 | is => 'ro', 16 | lazy => 1, 17 | default => sub { 18 | my $self = shift; 19 | MetaCPAN::Query->new( es => $self->es ); 20 | }, 21 | ); 22 | 23 | sub ACCEPT_CONTEXT { 24 | my ( $self, $c ) = @_; 25 | if ( !$self->es ) { 26 | $self->_set_es( $c->model('ES') ); 27 | } 28 | return $self->_esx_query; 29 | } 30 | 31 | 1; 32 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Model/Search.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Model::Search; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use MetaCPAN::Query::Search (); 8 | 9 | extends 'Catalyst::Model'; 10 | 11 | has es => ( 12 | is => 'ro', 13 | writer => '_set_es', 14 | ); 15 | 16 | has search => ( 17 | is => 'ro', 18 | isa => 'MetaCPAN::Query::Search', 19 | lazy => 1, 20 | default => sub { 21 | my $self = shift; 22 | return MetaCPAN::Query::Search->new( es => $self->es ); 23 | }, 24 | ); 25 | 26 | sub ACCEPT_CONTEXT { 27 | my ( $self, $c ) = @_; 28 | if ( !$self->es ) { 29 | $self->_set_es( $c->model('ES') ); 30 | } 31 | return $self->search; 32 | } 33 | 34 | 1; 35 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/QuerySanitizer.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::QuerySanitizer; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use MetaCPAN::Types::TypeTiny qw( HashRef Maybe ); 8 | 9 | has query => ( 10 | is => 'ro', 11 | isa => Maybe [HashRef], 12 | trigger => \&_build_clean_query, 13 | ); 14 | 15 | sub _build_clean_query { 16 | my ($self) = @_; 17 | my $search = $self->query 18 | or return; 19 | 20 | _scan_hash_tree($search); 21 | 22 | return $search; 23 | } 24 | 25 | # if we want a regexp we could do { $key = qr/^\Q$key\E$/ if !ref $key; } 26 | my $key = 'script'; 27 | 28 | sub _scan_hash_tree { 29 | my ($struct) = @_; 30 | 31 | my $ref = ref($struct); 32 | if ( $ref eq 'HASH' ) { 33 | while ( my ( $k, $v ) = each %$struct ) { 34 | if ( $k eq $key ) { 35 | MetaCPAN::Server::QuerySanitizer::Error->throw( 36 | message => qq[Parameter "$key" not allowed], ); 37 | } 38 | _scan_hash_tree($v) if ref $v; 39 | } 40 | } 41 | elsif ( $ref eq 'ARRAY' ) { 42 | foreach my $item (@$struct) { 43 | _scan_hash_tree($item) if ref($item); 44 | } 45 | } 46 | 47 | # Mickey: what about $ref eq 'JSON::PP::Boolean' ? 48 | } 49 | 50 | __PACKAGE__->meta->make_immutable; 51 | 52 | { 53 | 54 | package MetaCPAN::Server::QuerySanitizer::Error; 55 | use Moose; 56 | extends 'Throwable::Error'; 57 | __PACKAGE__->meta->make_immutable; 58 | } 59 | 60 | 1; 61 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Role/JSONP.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Role::JSONP; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose::Role; 7 | 8 | has enable_jsonp => ( 9 | is => 'ro', 10 | default => 1, 11 | ); 12 | 13 | 1; 14 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Role/Request.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Role::Request; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose::Role; 7 | 8 | around [qw(content_type header)] => sub { 9 | my ( $orig, $self ) = ( shift, shift ); 10 | my $header = $self->$orig(@_); 11 | return unless ($header); 12 | return $header =~ /^application\/x-www-form-urlencoded/ 13 | ? 'application/json' 14 | : $header; 15 | }; 16 | 17 | sub fields { 18 | my $self = shift; 19 | my @fields = map { split /,/ } $self->param('fields'); 20 | return @fields ? \@fields : undef; 21 | } 22 | 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/User.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::User; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | 8 | extends 'Catalyst::Authentication::User'; 9 | 10 | has obj => ( 11 | is => 'ro', 12 | isa => 'MetaCPAN::Model::User::Account', 13 | writer => '_set_obj', 14 | ); 15 | 16 | sub get_object { shift->obj } 17 | 18 | sub store {'Catalyst::Authentication::Plugin::Store::Proxy'} 19 | 20 | sub for_session { 21 | shift->obj->id; 22 | } 23 | 24 | sub from_session { 25 | my ( $self, $c, $id ) = @_; 26 | my $user = $c->model('ESModel')->doc('account')->get($id); 27 | $self->_set_obj($user) if ($user); 28 | return $user ? $self : undef; 29 | } 30 | 31 | sub find_user { 32 | my ( $self, $auth ) = @_; 33 | $self->_set_obj( $auth->{user} ); 34 | return $self; 35 | } 36 | 37 | sub supports { 38 | my ( $self, @feature ) = @_; 39 | return 1 if ( grep { $_ eq 'session' } @feature ); 40 | } 41 | 42 | sub data { 43 | my $self = shift; 44 | return $self->obj->meta->get_data( $self->obj ); 45 | } 46 | 47 | __PACKAGE__->meta->make_immutable( inline_constructor => 0 ); 48 | 1; 49 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/View/JSON.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::View::JSON; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Cpanel::JSON::XS (); 7 | use Moose; 8 | 9 | extends 'Catalyst::View::JSON'; 10 | 11 | sub encode_json { 12 | my ( $self, $c, $data ) = @_; 13 | my $encoder 14 | = $c->req->looks_like_browser 15 | ? Cpanel::JSON::XS->new->utf8->allow_blessed->pretty 16 | : Cpanel::JSON::XS->new->utf8->allow_blessed; 17 | $encoder->encode( exists $data->{rest} ? $data->{rest} : $data ); 18 | } 19 | 20 | 1; 21 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/View/JSONP.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::View::JSONP; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Cpanel::JSON::XS (); 7 | use Encode qw( decode_utf8 ); 8 | use Moose; 9 | 10 | extends 'Catalyst::View'; 11 | 12 | sub process { 13 | my ( $self, $c ) = @_; 14 | return 1 unless ( my $cb = $c->req->params->{callback} ); 15 | my $body = $c->res->body; 16 | if ( ref($body) ) { 17 | local ($/); 18 | $body = <$body>; 19 | } 20 | $body = decode_utf8($body); 21 | my $content_type = $c->res->content_type; 22 | return 1 if ( $content_type eq 'text/javascript' ); 23 | if ( $content_type ne 'application/json' ) { 24 | $body = Cpanel::JSON::XS->new->allow_nonref->ascii->encode($body); 25 | } 26 | $c->res->body("/**/$cb($body);"); 27 | return 1; 28 | } 29 | 30 | 1; 31 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/View/Pod.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::View::Pod; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use MetaCPAN::Pod::Renderer (); 7 | use Moose; 8 | 9 | extends 'Catalyst::View'; 10 | 11 | sub process { 12 | my ( $self, $c ) = @_; 13 | 14 | my $content = $c->res->has_body ? $c->res->body : $c->stash->{source}; 15 | my $link_mappings = $c->stash->{link_mappings}; 16 | my $url_prefix = $c->stash->{url_prefix}; 17 | if ( ref $content ) { 18 | $content = do { local $/; <$content> }; 19 | } 20 | 21 | my ( $body, $content_type ); 22 | my $accept = eval { $c->req->preferred_content_type } || 'text/html'; 23 | my $show_errors = $c->stash->{show_errors}; 24 | 25 | my $renderer = $self->_factory( 26 | ( $url_prefix ? ( perldoc_url_prefix => $url_prefix ) : () ), 27 | no_errata_section => !$show_errors, 28 | ( $link_mappings ? ( link_mappings => $link_mappings ) : () ), 29 | ); 30 | if ( $accept eq 'text/plain' ) { 31 | $body = $renderer->to_text($content); 32 | $content_type = 'text/plain'; 33 | } 34 | elsif ( $accept eq 'text/x-pod' ) { 35 | $body = $renderer->to_pod($content); 36 | $content_type = 'text/plain'; 37 | } 38 | elsif ( $accept eq 'text/x-markdown' ) { 39 | $body = $renderer->to_markdown($content); 40 | $content_type = 'text/plain'; 41 | } 42 | else { 43 | $body = $renderer->to_html($content); 44 | $content_type = 'text/html'; 45 | } 46 | 47 | $c->res->content_type($content_type); 48 | $c->res->body($body); 49 | } 50 | 51 | sub _factory { 52 | my $self = shift; 53 | return MetaCPAN::Pod::Renderer->new(@_); 54 | } 55 | 56 | 1; 57 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Types.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Types; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use parent 'MooseX::Types::Combine'; 7 | 8 | __PACKAGE__->provide_types_from( qw( 9 | MetaCPAN::Types::Internal 10 | ) ); 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /log4perl.conf: -------------------------------------------------------------------------------- 1 | log4perl.rootLogger=DEBUG, OUTPUT 2 | 3 | log4perl.appender.OUTPUT=Log::Log4perl::Appender::Screen 4 | log4perl.appender.OUTPUT.stderr=1 5 | 6 | log4perl.appender.OUTPUT.layout=PatternLayout 7 | log4perl.appender.OUTPUT.layout.ConversionPattern=[%d] [%p] [%X{url}] %m%n 8 | -------------------------------------------------------------------------------- /log4perl_prod.conf: -------------------------------------------------------------------------------- 1 | log4perl.rootLogger=WARN, OUTPUT, SYSLOG 2 | 3 | log4perl.appender.OUTPUT=Log::Log4perl::Appender::Screen 4 | log4perl.appender.OUTPUT.stderr=1 5 | 6 | log4perl.appender.OUTPUT.layout=PatternLayout 7 | log4perl.appender.OUTPUT.layout.ConversionPattern=[%d] [%p] [%X{url}] %m%n 8 | 9 | log4perl.appender.SYSLOG=Log::Dispatch::Syslog 10 | log4perl.appender.SYSLOG.ident = metacpan_api 11 | log4perl.appender.SYSLOG.facility = local0 12 | log4perl.appender.SYSLOG.layout = Log::Log4perl::Layout::JSON 13 | log4perl.appender.SYSLOG.layout.field.message = %m{chomp} 14 | log4perl.appender.SYSLOG.layout.field.category = %c 15 | log4perl.appender.SYSLOG.layout.field.class = %C 16 | log4perl.appender.SYSLOG.layout.field.file = %F{1} 17 | log4perl.appender.SYSLOG.layout.field.sub = %M{1} 18 | log4perl.appender.SYSLOG.layout.include_mdc = 1 19 | -------------------------------------------------------------------------------- /metacpan_server.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | git: /usr/bin/git 3 | 4 | cpan: /CPAN 5 | secret: "the stone roses" 6 | level: info 7 | elasticsearch_servers: 8 | client: '2_0::Direct' 9 | nodes: http://elasticsearch:9200 10 | minion_dsn: "postgresql://metacpan:t00lchain@pghost:5432/minion_queue" 11 | port: 5000 12 | 13 | logger: 14 | class: Log::Log4perl::Appender::File 15 | filename: ../var/log/metacpan.log 16 | syswrite: 1 17 | 18 | smtp: 19 | host: smtp.fastmail.com 20 | port: 465 21 | username: foo@metacpan.org 22 | password: seekrit 23 | 24 | oauth: 25 | github: 26 | key: seekrit 27 | secret: seekrit 28 | google: 29 | key: seekrit 30 | secret: seekrit 31 | twitter: 32 | key: seekrit 33 | secret: seekrit 34 | 35 | front_end_url: http://0.0.0.0:5001 36 | -------------------------------------------------------------------------------- /metacpan_server_testing.yaml: -------------------------------------------------------------------------------- 1 | git: /usr/bin/git 2 | cpan: var/t/tmp/fakecpan 3 | die_on_error: 1 4 | level: warn 5 | port: 5000 6 | source_base: var/t/tmp/source 7 | 8 | elasticsearch_servers: 9 | client: '2_0::Direct' 10 | nodes: http://elasticsearch_test:9200 11 | 12 | minion_dsn: "postgresql://metacpan:t00lchain@pghost:5432/minion_queue" 13 | 14 | logger: 15 | class: Log::Log4perl::Appender::Screen 16 | name: testing 17 | 18 | secret: weak 19 | 20 | smtp: 21 | host: smtp.fastmail.com 22 | port: 465 23 | username: foo@metacpan.org 24 | password: seekrit 25 | 26 | oauth: 27 | github: 28 | key: seekrit 29 | secret: seekrit 30 | google: 31 | key: seekrit 32 | secret: seekrit 33 | twitter: 34 | key: seekrit 35 | secret: seekrit 36 | 37 | front_end_url: http://0.0.0.0:5001 38 | -------------------------------------------------------------------------------- /perlimports.toml: -------------------------------------------------------------------------------- 1 | # Valid log levels are: 2 | # debug, info, notice, warning, error, critical, alert, emergency 3 | # critical, alert and emergency are not currently used. 4 | # 5 | # Please use boolean values in this config file. Negated options (--no-*) are 6 | # not permitted here. Explicitly set options to true or false. 7 | # 8 | # Some of these values deviate from the regular perlimports defaults. In 9 | # particular, you're encouraged to leave preserve_duplicates and 10 | # preserve_unused disabled. 11 | 12 | cache = false # setting this to true is currently discouraged 13 | ignore_modules = ["Catalyst::Runtime","Module::Pluggable", "namespace::clean", "Test::More", "Type::Library", "With::Roles", "File::Find::Rule::Perl"] 14 | ignore_modules_filename = "" 15 | ignore_modules_pattern = "" # regex like "^(Foo|Foo::Bar)" 16 | ignore_modules_pattern_filename = "" 17 | libs = ["lib", "t/lib"] 18 | log_filename = "" 19 | log_level = "warn" 20 | never_export_modules = [] 21 | never_export_modules_filename = "" 22 | padding = true 23 | preserve_duplicates = false 24 | preserve_unused = false 25 | tidy_whitespace = true 26 | -------------------------------------------------------------------------------- /precious.toml: -------------------------------------------------------------------------------- 1 | excludes = [ 2 | ".build/**", 3 | "blib/**", 4 | "root/assets/**", 5 | ] 6 | 7 | [commands.perlimports] 8 | type = "both" 9 | include = [ "**/*.{pl,pm,t,psgi}" ] 10 | cmd = [ "perlimports" ] 11 | lint-flags = ["--lint" ] 12 | tidy-flags = ["-i" ] 13 | ok-exit-codes = 0 14 | expect-stderr = true 15 | 16 | [commands.perlcritic] 17 | type = "lint" 18 | include = [ "**/*.{pl,pm,t,psgi}" ] 19 | cmd = [ "perlcritic", "--profile=$PRECIOUS_ROOT/.perlcriticrc" ] 20 | ok-exit-codes = 0 21 | lint-failure-exit-codes = 2 22 | 23 | [commands.perltidy] 24 | type = "both" 25 | include = [ "**/*.{pl,pm,t,psgi}" ] 26 | cmd = [ "perltidy", "--profile=$PRECIOUS_ROOT/.perltidyrc" ] 27 | lint-flags = [ "--assert-tidy", "--no-standard-output", "--outfile=/dev/null" ] 28 | tidy-flags = [ "--backup-and-modify-in-place", "--backup-file-extension=/" ] 29 | ok-exit-codes = 0 30 | lint-failure-exit-codes = 2 31 | ignore-stderr = "Begin Error Output Stream" 32 | label = ["perltidy"] 33 | 34 | [commands.omegasort-gitignore] 35 | type = "both" 36 | include = "**/.gitignore" 37 | cmd = [ "omegasort", "--sort", "path", "--unique" ] 38 | lint-flags = "--check" 39 | tidy-flags = "--in-place" 40 | ok-exit-codes = 0 41 | lint-failure-exit-codes = 1 42 | ignore-stderr = [ 43 | "The .+ file is not sorted", 44 | "The .+ file is not unique", 45 | ] 46 | -------------------------------------------------------------------------------- /root/static/definitions/common.yml: -------------------------------------------------------------------------------- 1 | --- 2 | 3 | ErrorModel: 4 | type: "object" 5 | required: 6 | - "code" 7 | - "message" 8 | properties: 9 | code: 10 | type: "integer" 11 | format: "int32" 12 | message: 13 | type: "string" 14 | -------------------------------------------------------------------------------- /root/static/definitions/definitions.yml: -------------------------------------------------------------------------------- 1 | --- 2 | 3 | # Maintain names and descriptions of common attributes 4 | dist_fav_count: 5 | description: Number of times favorited 6 | -------------------------------------------------------------------------------- /root/static/definitions/results.yml: -------------------------------------------------------------------------------- 1 | --- 2 | 3 | search_result_items: 4 | type: object 5 | properties: 6 | distribution: 7 | type: string 8 | hits: 9 | title: Hits 10 | type: array 11 | items: 12 | $ref: "#/search_result_hit" 13 | 14 | total: 15 | type: integer 16 | search_result_hit: 17 | type: object 18 | properties: 19 | description: 20 | type: string 21 | documentation: 22 | type: string 23 | authorized: 24 | type: boolean 25 | path: 26 | type: string 27 | author: 28 | type: string 29 | id: 30 | type: string 31 | date: 32 | type: string 33 | favorites: 34 | type: 35 | - "integer" 36 | - "null" 37 | status: 38 | type: string 39 | score: 40 | type: number 41 | module: 42 | type: array 43 | items: 44 | type: object 45 | properties: 46 | associated_pod: 47 | type: string 48 | indexed: 49 | type: boolean 50 | name: 51 | type: string 52 | authorized: 53 | type: boolean 54 | version_numified: 55 | type: number 56 | distribution: 57 | type: string 58 | indexed: 59 | type: boolean 60 | pod_lines: 61 | type: array 62 | abstract: 63 | type: string 64 | release: 65 | type: string 66 | dependency: 67 | type: object 68 | properties: 69 | module: 70 | type: string 71 | # "Mojolicious", 72 | phase: 73 | type: string 74 | # "runtime", 75 | version: 76 | type: string 77 | # "8", 78 | relationship: 79 | type: string 80 | # "requires" 81 | -------------------------------------------------------------------------------- /root/static/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metacpan/metacpan-api/0200d6169473b356a0ac3b16553a665c8bfe952d/root/static/favicon.ico -------------------------------------------------------------------------------- /root/static/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | MetaCPAN API 5 | 6 | 7 | 8 | 9 | 10 | 13 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | -------------------------------------------------------------------------------- /root/static/requests/release.yml: -------------------------------------------------------------------------------- 1 | /release/recent: 2 | get: 3 | tags: 4 | - Release 5 | operationId: release_recent 6 | x-mojo-to: Release#recent 7 | summary: Get recent releases 8 | parameters: 9 | - in: path 10 | name: name 11 | description: | 12 | The name of the Release 13 | type: string 14 | required: true 15 | responses: 16 | 200: 17 | description: Release response 18 | schema: 19 | type: object 20 | properties: 21 | name: 22 | type: string 23 | dependency: 24 | type: array 25 | items: 26 | $ref: "./definitions/results.yml#/dependency" 27 | /release/{name}: 28 | get: 29 | tags: 30 | - Release 31 | operationId: release_by_name 32 | x-mojo-to: Release#by_name 33 | summary: Get details about a release 34 | parameters: 35 | - in: path 36 | name: name 37 | description: | 38 | The name of the Release 39 | type: string 40 | required: true 41 | responses: 42 | 200: 43 | description: Release response 44 | schema: 45 | type: object 46 | properties: 47 | name: 48 | type: string 49 | -------------------------------------------------------------------------------- /root/static/v1.yml: -------------------------------------------------------------------------------- 1 | --- 2 | 3 | swagger: "2.0" 4 | info: 5 | version: "1.0.0" 6 | title: "MetaCPAN API" 7 | basePath: "/v1" 8 | tags: 9 | - name: Search 10 | description: MetaCPAN Search Endpoints 11 | # - name: Release 12 | # description: Distribution Release Endpoints 13 | schemes: 14 | - "http" 15 | - "https" 16 | consumes: 17 | - "application/json" 18 | produces: 19 | - "application/json" 20 | paths: 21 | /search/web: 22 | $ref: "requests/search.yml#/search_web" 23 | /search/first: 24 | $ref: "requests/search.yml#/search_first" 25 | /cover/{name}: 26 | $ref: "requests/cover.yml#/cover" 27 | -------------------------------------------------------------------------------- /t/01_darkpan.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use Devel::Confess; 6 | use MetaCPAN::DarkPAN (); 7 | use MetaCPAN::Tests::Controller::Search::DownloadURL (); 8 | use MetaCPAN::TestServer (); 9 | use Test::More; 10 | use Test::RequiresInternet ( 'cpan.metacpan.org' => 80 ); 11 | 12 | my $darkpan = MetaCPAN::DarkPAN->new; 13 | my $server = MetaCPAN::TestServer->new( cpan_dir => $darkpan->base_dir ); 14 | 15 | # create DarkPAN 16 | $darkpan->run; 17 | 18 | $server->index_releases( bulk_size => 1 ); 19 | 20 | SKIP: { 21 | # XXX "path does not support inner_hits" 22 | skip( 'Download URL not yet fully implemented', 1 ); 23 | my $url_tests = MetaCPAN::Tests::Controller::Search::DownloadURL->new; 24 | $url_tests->run; 25 | } 26 | 27 | done_testing(); 28 | -------------------------------------------------------------------------------- /t/api/controller/admin.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use Test::Mojo; 6 | use Test::More; 7 | 8 | local $ENV{MOJO_SECRET} = 'Magritte'; 9 | local $ENV{GITHUB_KEY} = 'foo'; 10 | local $ENV{GITHUB_SECRET} = 'bar'; 11 | 12 | subtest 'authentication enabled' => sub { 13 | my $t = Test::Mojo->new('MetaCPAN::API'); 14 | $t->post_ok('/admin/enqueue'); 15 | $t->header_is( Location => '/auth/github/authenticate' ); 16 | $t->status_is(302); 17 | }; 18 | 19 | subtest 'index release' => sub { 20 | local $ENV{FORCE_ADMIN_AUTH} = 'tester'; 21 | my $t = Test::Mojo->new('MetaCPAN::API'); 22 | $t->get_ok('/admin/index-release'); 23 | $t->status_is(200); 24 | }; 25 | 26 | subtest 'search identities' => sub { 27 | local $ENV{FORCE_ADMIN_AUTH} = 'tester'; 28 | my $t = Test::Mojo->new('MetaCPAN::API'); 29 | $t->get_ok('/admin/identity-search-form'); 30 | $t->status_is(200); 31 | 32 | $t->post_ok( '/admin/search-identities' => form => 33 | { name => 'pause', key => 'MO' } ); 34 | $t->content_like(qr/\bMO\b/); 35 | $t->content_like(qr/\bpause\b/); 36 | $t->status_is(200); 37 | }; 38 | 39 | done_testing(); 40 | -------------------------------------------------------------------------------- /t/api/controller/cover.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestServer (); 6 | use Test::Mojo (); 7 | use Test::More; 8 | 9 | my $server = MetaCPAN::TestServer->new; 10 | 11 | my $t = Test::Mojo->new( 12 | 'MetaCPAN::API' => { 13 | es => $server->es_client, 14 | secret => 'just a test', 15 | } 16 | ); 17 | 18 | my %expect = ( 19 | 'MetaFile-Both-1.1' => { 20 | criteria => { 21 | branch => '12.50', 22 | condition => '0.00', 23 | statement => '63.64', 24 | subroutine => '71.43', 25 | total => '46.51', 26 | }, 27 | distribution => 'MetaFile-Both', 28 | release => 'MetaFile-Both-1.1', 29 | url => 'http://cpancover.com/latest/MetaFile-Both-1.1/index.html', 30 | version => '1.1', 31 | }, 32 | 'Pod-With-Generator-1' => { 33 | criteria => { 34 | branch => '78.95', 35 | condition => '46.67', 36 | statement => '95.06', 37 | subroutine => '100.00', 38 | total => '86.58', 39 | }, 40 | distribution => 'Pod-With-Generator', 41 | release => 'Pod-With-Generator-1', 42 | url => 'http://cpancover.com/latest/Pod-With-Generator-1/index.html', 43 | version => '1', 44 | }, 45 | ); 46 | 47 | for my $release ( keys %expect ) { 48 | my $expected = $expect{$release}; 49 | subtest "Check $release" => sub { 50 | 51 | $t->get_ok("/v1/cover/$release")->status_is(200)->json_is($expected) 52 | ->or( sub { diag $t->tx->res->dom } ); 53 | 54 | }; 55 | } 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/api/controller/search/first.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | 3 | use Test::Mojo (); 4 | use Test::More; 5 | 6 | my $t = Test::Mojo->new('MetaCPAN::API'); 7 | 8 | $t->get_ok( '/v1/search/first', form => { q => 'Versions::PkgVar' } ) 9 | ->status_is(200)->json_like( '/release' => qr/Versions-(?:\d+)/ ); 10 | 11 | $t->get_ok( '/v1/search/first', form => { q => 'DOESNOTEXISTS' } ) 12 | ->status_is(404)->content_is(''); 13 | 14 | done_testing; 15 | -------------------------------------------------------------------------------- /t/api/queue.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::DarkPAN (); 6 | use Path::Tiny qw( path ); 7 | use Test::Mojo; 8 | use Test::More; 9 | 10 | my $t = Test::Mojo->new('MetaCPAN::API'); 11 | my $app = $t->app; 12 | 13 | ok( $app, 'queue app' ); 14 | isa_ok $app, 'MetaCPAN::API'; 15 | 16 | my $darkpan = MetaCPAN::DarkPAN->new->base_dir; 17 | my $release = path( $darkpan, 'authors/id/E/ET/ETHER/Try-Tiny-0.23.tar.gz' ); 18 | 19 | $app->minion->enqueue( index_release => [$release] ); 20 | $app->minion->enqueue( index_release => [ '--latest', $release ] ); 21 | 22 | $app->minion->perform_jobs; 23 | 24 | done_testing(); 25 | -------------------------------------------------------------------------------- /t/config.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use MetaCPAN::Server::Config (); 7 | use Test::More; 8 | 9 | my $config = MetaCPAN::Server::Config::config(); 10 | ok($config); 11 | 12 | done_testing(); 13 | -------------------------------------------------------------------------------- /t/document/author.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Document::Author (); 6 | use Test::More; 7 | 8 | my @errors = MetaCPAN::Document::Author->validate( 9 | { perlmongers => { name => 'foo.pm' } } ); 10 | 11 | ok( !( grep { $_->{field} eq 'perlmongers' } @errors ), 'perlmongers ok' ); 12 | 13 | done_testing; 14 | -------------------------------------------------------------------------------- /t/fff_tidyall.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | use lib 't/lib'; 6 | 7 | use Test::Code::TidyAll qw( tidyall_ok ); 8 | tidyall_ok( verbose => $ENV{TEST_VERBOSE} ); 9 | -------------------------------------------------------------------------------- /t/lib/MetaCPAN/Tests/Controller/Search/DownloadURL.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Tests::Controller::Search::DownloadURL; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use MetaCPAN::Server::Test qw( app GET test_psgi ); 7 | use MetaCPAN::TestHelpers qw( decode_json_ok ); 8 | use Moose; 9 | use Test::More; 10 | 11 | sub run { 12 | test_psgi app, sub { 13 | my $cb = shift; 14 | 15 | my $module = 'CPAN::Test::Dummy::Perl5::VersionBump::Decrease'; 16 | 17 | # test ES script using doc['blah'] value 18 | ok( my $res = $cb->( GET '/download_url/' . $module ), 19 | "GET $module" ); 20 | my $json = decode_json_ok($res); 21 | 22 | diag explain $json; 23 | 24 | # my $got 25 | # = [ map { $_->{_source}{documentation} } 26 | # @{ $json->{hits}{hits} } ]; 27 | # 28 | # is_deeply $got, [ 29 | # qw( 30 | # Multiple::Modules 31 | # Multiple::Modules::A 32 | # Multiple::Modules::B 33 | # Multiple::Modules::RDeps 34 | # Multiple::Modules::Tester 35 | # Multiple::Modules::RDeps::A 36 | # Multiple::Modules::RDeps::Deprecated 37 | # ) 38 | # ], 39 | # 'results are sorted by module name length' 40 | # or diag( Test::More::explain($got) ); 41 | # } 42 | }; 43 | } 44 | 45 | __PACKAGE__->meta->make_immutable; 46 | 1; 47 | -------------------------------------------------------------------------------- /t/lib/MetaCPAN/Tests/Distribution.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Tests::Distribution; 2 | use Test::More; 3 | use Test::Routine; 4 | use version; 5 | use MetaCPAN::Types::TypeTiny qw( Str ); 6 | 7 | with qw( MetaCPAN::Tests::Query ); 8 | 9 | sub _build_type {'distribution'} 10 | 11 | sub _build_search { 12 | my $self = shift; 13 | return { term => { name => $self->name } }; 14 | } 15 | 16 | my @attrs = qw( 17 | name 18 | ); 19 | 20 | has [@attrs] => ( 21 | is => 'ro', 22 | isa => Str, 23 | ); 24 | 25 | test 'distribution attributes' => sub { 26 | my ($self) = @_; 27 | 28 | foreach my $attr (@attrs) { 29 | is $self->data->{$attr}, $self->$attr, $attr; 30 | } 31 | }; 32 | 33 | 1; 34 | -------------------------------------------------------------------------------- /t/lib/MetaCPAN/Tests/Extra.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Tests::Extra; 2 | use Test::More; 3 | use Test::Routine; 4 | use MetaCPAN::Types::TypeTiny qw( CodeRef ); 5 | 6 | around BUILDARGS => sub { 7 | my ( $orig, $class, @args ) = @_; 8 | my $attr = $class->$orig(@args); 9 | 10 | delete $attr->{_expect}{extra_tests}; 11 | 12 | return $attr; 13 | }; 14 | 15 | has _extra_tests => ( 16 | is => 'ro', 17 | isa => CodeRef, 18 | init_arg => 'extra_tests', 19 | predicate => 'has_extra_tests', 20 | ); 21 | 22 | test 'extra tests' => sub { 23 | my ($self) = @_; 24 | 25 | plan skip_all => 'No extra tests defined' 26 | if !$self->has_extra_tests; 27 | 28 | $self->_extra_tests->($self); 29 | }; 30 | 31 | 1; 32 | -------------------------------------------------------------------------------- /t/lib/MetaCPAN/Tests/PSGI.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Tests::PSGI; 2 | 3 | use Test::More; 4 | use Test::Routine; 5 | 6 | use MetaCPAN::Server::Test qw( app test_psgi ); 7 | 8 | sub psgi_app { 9 | my ( $self, $sub ) = @_; 10 | my @result; 11 | 12 | test_psgi( 13 | app => app(), 14 | client => sub { 15 | @result = $sub->(@_); 16 | }, 17 | ); 18 | 19 | return $result[0]; 20 | } 21 | 22 | 1; 23 | -------------------------------------------------------------------------------- /t/lib/Module/Faker/Dist/WithPerl.pm: -------------------------------------------------------------------------------- 1 | package # no_index 2 | Module::Faker::Dist::WithPerl; 3 | 4 | use Moose; 5 | extends 'Module::Faker::Dist'; 6 | 7 | use Encode qw( encode_utf8 ); 8 | 9 | around append_for => sub { 10 | my ( $orig, $self, $filename ) = @_; 11 | return [ 12 | # $orig normally expects utf-8 (yaml, json, etc) 13 | # but the reason for this subclass is to allow other encodings 14 | map { 15 | utf8::is_utf8( $_->{content} ) 16 | ? encode_utf8( $_->{content} ) 17 | : $_->{content} 18 | } 19 | grep { $filename eq $_->{file} } @{ $self->append } 20 | ]; 21 | }; 22 | 23 | around from_file => sub { 24 | my ( $orig, $self, $filename ) = @_; 25 | 26 | # I'm not thrilled abot this but found it necessary for mixed encoding dists 27 | return $self->_from_perl_file($filename) 28 | if $filename =~ /\.pl$/; 29 | 30 | return $self->$orig($filename); 31 | }; 32 | 33 | # be consistent with _from_meta_file so that the hash structures can be consistent 34 | sub _from_perl_file { 35 | my ( $self, $filename ) = @_; 36 | 37 | my $data = do($filename); 38 | 39 | my $extra = ( delete $data->{X_Module_Faker} ) || {}; 40 | my $dist = $self->new( { %$data, %$extra } ); 41 | } 42 | 43 | __PACKAGE__->meta->make_immutable; 44 | 1; 45 | -------------------------------------------------------------------------------- /t/model/email/pause.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | ## no critic (Modules::RequireFilenameMatchesPackage) 5 | package Author; 6 | 7 | use MetaCPAN::Moose; 8 | 9 | use MetaCPAN::Types::TypeTiny qw( ArrayRef Str ); 10 | 11 | has name => ( 12 | is => 'ro', 13 | isa => Str, 14 | init_arg => 'name', 15 | ); 16 | 17 | has email => ( 18 | is => 'ro', 19 | isa => ArrayRef [Str], 20 | required => 1, 21 | ); 22 | 23 | __PACKAGE__->meta->make_immutable; 24 | 1; 25 | 26 | package main; 27 | 28 | BEGIN { $ENV{EMAIL_SENDER_TRANSPORT} = 'Test' } 29 | 30 | use Test::More; 31 | 32 | use MetaCPAN::Model::Email::PAUSE (); 33 | 34 | my $author = Author->new( 35 | name => 'Olaf Alders', 36 | email => ['oalders@metacpan.org'], 37 | ); 38 | 39 | my $email = MetaCPAN::Model::Email::PAUSE->new( 40 | author => $author, 41 | url => URI->new('http://example.com'), 42 | ); 43 | 44 | ok( $email->_email_body, 'email_body' ); 45 | ok( $email->send, 'send email' ); 46 | diag $email->_email_body; 47 | 48 | my @messages = Email::Sender::Simple->default_transport->deliveries; 49 | is( @messages, 1, '1 message sent' ); 50 | 51 | done_testing(); 52 | 1; 53 | -------------------------------------------------------------------------------- /t/model/release.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use File::Temp (); 6 | use LWP::Simple qw( getstore ); 7 | use MetaCPAN::Model::Release (); 8 | use MetaCPAN::TestHelpers qw( get_config ); 9 | use Test::More; 10 | use Test::RequiresInternet( 'metacpan.org' => 'https' ); 11 | 12 | my $config = get_config(); 13 | my $url 14 | = 'https://cpan.metacpan.org/authors/id/D/DC/DCANTRELL/Acme-Pony-1.1.2.tar.gz'; 15 | 16 | my $archive_file = File::Temp->new; 17 | getstore $url, $archive_file->filename; 18 | ok -s $archive_file->filename; 19 | 20 | my $release 21 | = MetaCPAN::Model::Release->new( file => $archive_file->filename ); 22 | 23 | is $release->file, $archive_file->filename; 24 | 25 | done_testing(); 26 | -------------------------------------------------------------------------------- /t/model/release/dependencies.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Model::Release (); 6 | use MetaCPAN::TestHelpers qw( fakecpan_dir get_config ); 7 | use Test::Deep qw( cmp_bag ); 8 | use Test::More; 9 | 10 | my $config = get_config(); 11 | 12 | subtest 'basic dependencies' => sub { 13 | my $file 14 | = fakecpan_dir->child( 15 | '/authors/id/M/MS/MSCHWERN/Prereqs-Basic-0.01.tar.gz'); 16 | 17 | my $release = MetaCPAN::Model::Release->new( file => $file ); 18 | 19 | my $dependencies = $release->dependencies; 20 | 21 | cmp_bag $dependencies, 22 | [ 23 | { 24 | phase => 'build', 25 | relationship => 'requires', 26 | module => 'For::Build::Requires1', 27 | version => 2.45 28 | }, 29 | { 30 | phase => 'configure', 31 | relationship => 'requires', 32 | module => 'For::Configure::Requires1', 33 | version => 72 34 | }, 35 | { 36 | phase => 'runtime', 37 | relationship => 'requires', 38 | module => 'For::Runtime::Requires1', 39 | version => 0 40 | }, 41 | { 42 | phase => 'runtime', 43 | relationship => 'requires', 44 | module => 'For::Runtime::Requires2', 45 | version => 1.23 46 | }, 47 | { 48 | phase => 'runtime', 49 | relationship => 'recommends', 50 | module => 'For::Runtime::Recommends1', 51 | version => 0 52 | } 53 | ]; 54 | }; 55 | 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/model/release/metadata.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Model::Release (); 6 | use MetaCPAN::TestHelpers qw( fakecpan_dir get_config ); 7 | use Test::More; 8 | 9 | my $authordir = fakecpan_dir->child('authors/id/L/LO/LOCAL'); 10 | 11 | my $config = get_config(); 12 | 13 | my $ext = 'tar.gz'; 14 | foreach my $test ( 15 | [ 'MetaFile-YAML-1.1', 'Module::Faker', ['META.yml'] ], 16 | [ 'MetaFile-JSON-1.1', 'hand', ['META.json'] ], 17 | [ 'MetaFile-Both-1.1', 'hand', [ 'META.json', 'META.yml' ] ], 18 | ) 19 | { 20 | my ( $name, $genby, $files ) = @$test; 21 | 22 | my $path = "$authordir/$name.$ext"; 23 | die 'You need to build your fakepan (with t/fakepan.t) first' 24 | unless -e $path; 25 | 26 | my $release = MetaCPAN::Model::Release->new( file => $path ); 27 | my $meta = $release->metadata; 28 | 29 | # some way to identify which file the meta came from 30 | like eval { $meta->generated_by }, qr/^$genby/, 31 | "correct meta spec version for $name"; 32 | 33 | # Do this after calling metadata to ensure metadata does the 34 | # extraction. 35 | my $extract_dir = $release->extract; 36 | foreach my $file (@$files) { 37 | ok( 38 | -e $extract_dir->child( $name, $file ), 39 | "meta file $file exists in $name" 40 | ); 41 | } 42 | } 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/model/release/reverse_dependencies.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Server (); 6 | 7 | use Test::More; 8 | 9 | my $c = MetaCPAN::Server::; 10 | 11 | subtest 'distribution reverse_dependencies' => sub { 12 | my $data = [ 13 | sort { $a->[1] cmp $b->[1] } 14 | map +[ @{$_}{qw(author name)} ], 15 | @{ 16 | $c->model('ESQuery') 17 | ->release->reverse_dependencies('Multiple-Modules')->{data} 18 | } 19 | ]; 20 | 21 | is_deeply( 22 | $data, 23 | [ 24 | [ LOCAL => 'Multiple-Modules-RDeps-2.03' ], 25 | [ LOCAL => 'Multiple-Modules-RDeps-A-2.03' ], 26 | ], 27 | 'Got correct reverse dependencies for distribution.' 28 | ); 29 | }; 30 | 31 | subtest 'module reverse_dependencies' => sub { 32 | my $data = [ 33 | map +[ @{$_}{qw(author name)} ], 34 | @{ 35 | $c->model('ESQuery')->release->requires('Multiple::Modules') 36 | ->{data} 37 | } 38 | ]; 39 | 40 | is_deeply( 41 | $data, 42 | [ [ LOCAL => 'Multiple-Modules-RDeps-2.03' ], ], 43 | 'Got correct reverse dependencies for module.' 44 | ); 45 | }; 46 | 47 | subtest 'no reverse_dependencies' => sub { 48 | my $data 49 | = $c->model('ESQuery')->release->requires('DoesNotExist')->{data}; 50 | 51 | is_deeply( $data, [], 'Found no reverse dependencies for module.' ); 52 | }; 53 | 54 | done_testing; 55 | -------------------------------------------------------------------------------- /t/package.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Script::Runner (); 6 | use Test::More; 7 | 8 | local @ARGV = ('package'); 9 | 10 | # uses ./t/var/tmp/fakecpan/modules/02packages.details.txt 11 | ok( MetaCPAN::Script::Runner->run, 'runs' ); 12 | 13 | done_testing(); 14 | -------------------------------------------------------------------------------- /t/permission.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Script::Runner (); 6 | use Test::More; 7 | 8 | local @ARGV = ('permission'); 9 | 10 | # uses ./t/var/tmp/fakecpan/modules/06perms.txt 11 | ok( MetaCPAN::Script::Runner->run, 'runs' ); 12 | 13 | done_testing(); 14 | -------------------------------------------------------------------------------- /t/pod/renderer.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use Test::More; 6 | 7 | use MetaCPAN::Pod::Renderer (); 8 | 9 | my $factory = MetaCPAN::Pod::Renderer->new(); 10 | my $html_renderer = $factory->html_renderer; 11 | $html_renderer->index(0); 12 | 13 | my $got = q{}; 14 | 15 | my $source = <<'EOF'; 16 | =pod 17 | 18 | =head1 DESCRIPTION 19 | L 20 | =cut 21 | EOF 22 | 23 | { 24 | my $html = <<'EOF'; 25 |

DESCRIPTION Plack

26 | 27 | EOF 28 | 29 | $html_renderer->output_string( \$got ); 30 | $html_renderer->parse_string_document($source); 31 | is( $got, $html, 'XHTML linkifies to metacpan by default' ); 32 | } 33 | 34 | { 35 | my $md = <<'EOF'; 36 | # DESCRIPTION 37 | [Plack](https://metacpan.org/pod/Plack) 38 | EOF 39 | 40 | is( $factory->to_markdown($source), $md, 'markdown' ); 41 | } 42 | 43 | { 44 | my $text = <<'EOF'; 45 | DESCRIPTION 46 | Plack 47 | EOF 48 | 49 | is( $factory->to_text($source), $text, 'text' ); 50 | } 51 | 52 | { 53 | my $pod = <<'EOF'; 54 | =pod 55 | 56 | =head1 DESCRIPTION 57 | L 58 | 59 | =cut 60 | EOF 61 | 62 | is( $factory->to_pod($source), $pod, 'pod' ); 63 | } 64 | done_testing(); 65 | -------------------------------------------------------------------------------- /t/query.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use lib 't/lib'; 5 | 6 | use MetaCPAN::Query; 7 | use MetaCPAN::Server::Test (); 8 | use Test::More; 9 | use Scalar::Util qw(weaken refaddr); 10 | 11 | my $es = MetaCPAN::Server::Test::es(); 12 | 13 | { 14 | my $query = MetaCPAN::Query->new( es => $es ); 15 | my $release = $query->release; 16 | 17 | ok $release->isa('MetaCPAN::Query::Release'), 18 | 'release object is correct class'; 19 | is refaddr $release->query, refaddr $query, 'got same parent object'; 20 | 21 | weaken $release; 22 | weaken $query; 23 | ok !defined $query, 'parent object properly released' 24 | or diag explain $query; 25 | ok !defined $release, 'release object properly released' 26 | or diag explain $release; 27 | } 28 | 29 | { 30 | my $release = MetaCPAN::Query::Release->new( es => $es ); 31 | my $query = $release->query; 32 | 33 | ok $query->isa('MetaCPAN::Query'), 'query object is correct class'; 34 | is refaddr $query->release, refaddr $release, 'got same child object'; 35 | 36 | weaken $release; 37 | weaken $query; 38 | ok !defined $query, 'parent object properly released' 39 | or diag explain $query; 40 | ok !defined $release, 'release object properly released' 41 | or diag explain $release; 42 | } 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/query/release.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use lib 't/lib'; 5 | 6 | use MetaCPAN::Server::Test qw(query); 7 | use Test::More; 8 | 9 | my $query = query()->release; 10 | 11 | is( $query->_get_latest_release('DoesNotExist'), 12 | undef, '_get_latest_release returns undef when release does not exist' ); 13 | 14 | is( $query->reverse_dependencies('DoesNotExist'), 15 | undef, 'reverse_dependencies returns undef when release does not exist' ); 16 | 17 | is( 18 | $query->_get_provided_modules( 19 | { author => 'OALDERS', name => 'DOESNOTEXIST', } 20 | ), 21 | undef, 22 | '_get_provided_modules returns undef when modules cannot be found' 23 | ); 24 | 25 | is_deeply( 26 | $query->_get_provided_modules( 27 | { author => 'DOY', name => 'Try-Tiny-0.21', } 28 | ), 29 | ['Try::Tiny'], 30 | '_get_provided_modules returns undef when modules cannot be found' 31 | ); 32 | 33 | done_testing(); 34 | -------------------------------------------------------------------------------- /t/release/badpod.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Test::More; 8 | 9 | test_release( { 10 | name => 'BadPod-0.01', 11 | author => 'MO', 12 | authorized => true, 13 | first => true, 14 | provides => [ 'BadPod', ], 15 | main_module => 'BadPod', 16 | modules => { 17 | 'lib/BadPod.pm' => [ 18 | { 19 | name => 'BadPod', 20 | indexed => true, 21 | authorized => true, 22 | version => '0.01', 23 | version_numified => 0.01, 24 | associated_pod => 'MO/BadPod-0.01/lib/BadPod.pm', 25 | }, 26 | ], 27 | }, 28 | extra_tests => \&test_bad_pod, 29 | } ); 30 | 31 | sub test_bad_pod { 32 | my ($self) = @_; 33 | 34 | my $file = $self->file_by_path('lib/BadPod.pm'); 35 | 36 | is $file->{sloc}, 3, 'sloc'; 37 | is $file->{slop}, 4, 'slop'; 38 | 39 | is_deeply $file->{pod_lines}, [ [ 5, 7 ], ], 'no pod_lines'; 40 | 41 | is $file->{pod}, 42 | 43 | # The unknown "=head" directive will get dropped 44 | # but the paragraph following it is valid. 45 | q[NAME BadPod - Malformed POD There is no "more."], 'pod text'; 46 | } 47 | 48 | done_testing; 49 | -------------------------------------------------------------------------------- /t/release/bugs.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_distribution ); 6 | use Test::More; 7 | 8 | test_distribution( 9 | 'Moose', 10 | { 11 | bugs => { 12 | rt => { 13 | source => 14 | 'https://rt.cpan.org/Public/Dist/Display.html?Name=Moose', 15 | new => 15, 16 | open => 20, 17 | stalled => 4, 18 | patched => 0, 19 | resolved => 122, 20 | rejected => 23, 21 | active => 39, 22 | closed => 145, 23 | }, 24 | }, 25 | }, 26 | 'Test bug data for Moose dist', 27 | ); 28 | 29 | done_testing; 30 | -------------------------------------------------------------------------------- /t/release/common-files.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Test::More; 8 | 9 | test_release( { 10 | name => 'Common-Files-1.1', 11 | author => 'BORISNAT', 12 | authorized => true, 13 | first => true, 14 | provides => ['Common::Files'], 15 | modules => { 16 | 'lib/Common/Files.pm' => [ 17 | { 18 | name => 'Common::Files', 19 | indexed => true, 20 | authorized => true, 21 | version => '1.1', 22 | version_numified => 1.1, 23 | associated_pod => 24 | 'BORISNAT/Common-Files-1.1/lib/Common/Files.pm', 25 | }, 26 | ], 27 | }, 28 | extra_tests => sub { 29 | my ($self) = @_; 30 | 31 | { 32 | my $file = $self->file_by_path('Makefile.PL'); 33 | 34 | ok !$file->{indexed}, 'Makefile.PL not indexed'; 35 | ok $file->{authorized}, 36 | 'Makefile.PL authorized, i suppose (not *un*authorized)'; 37 | is $file->{sloc}, 1, 'sloc'; 38 | is $file->{slop}, 3, 'slop'; 39 | 40 | is scalar( @{ $file->{pod_lines} } ), 1, 'one pod section'; 41 | 42 | is $file->{abstract}, undef, 'no abstract'; 43 | } 44 | 45 | }, 46 | } ); 47 | 48 | done_testing; 49 | -------------------------------------------------------------------------------- /t/release/devel-gofaster-0.000.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Test::More; 8 | 9 | test_release( { 10 | name => 'Devel-GoFaster-0.000', 11 | distribution => 'Devel-GoFaster', 12 | author => 'LOCAL', 13 | authorized => true, 14 | first => true, 15 | version => '0.000', 16 | 17 | provides => [ 'Devel::GoFaster', ], 18 | 19 | # Don't test the actual numbers since we copy this out of the real 20 | # database as a live test case. 21 | tests => 1, 22 | } ); 23 | 24 | done_testing; 25 | -------------------------------------------------------------------------------- /t/release/documentation-not-readme.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw( true false ); 7 | use Test::More; 8 | 9 | test_release( 10 | 'RWSTAUNER/Documentation-Not-Readme-0.01', 11 | { 12 | first => true, 13 | extra_tests => \&test_modules, 14 | main_module => 'Documentation::Not::Readme', 15 | } 16 | ); 17 | 18 | sub test_modules { 19 | my ($self) = @_; 20 | 21 | my @files = @{ $self->module_files }; 22 | is( @files, 1, 'includes one file with modules' ); 23 | 24 | my $file = shift @files; 25 | is( @{ $file->{module} }, 1, 'file contains one module' ); 26 | 27 | my ($indexed) = grep { $_->{indexed} } @{ $file->{module} }; 28 | 29 | is( $indexed->{name}, 'Documentation::Not::Readme', 'module name' ); 30 | is( $file->{documentation}, 31 | 'Documentation::Not::Readme', 'documentation' ); 32 | 33 | is( $indexed->{associated_pod}, 34 | 'RWSTAUNER/Documentation-Not-Readme-0.01/lib/Documentation/Not/Readme.pm' 35 | ); 36 | } 37 | 38 | done_testing; 39 | -------------------------------------------------------------------------------- /t/release/file-changes.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Server::Test qw( es_result ); 6 | use Test::More; 7 | 8 | my $release = es_result( 9 | release => { 10 | bool => { 11 | must => [ 12 | { term => { author => 'LOCAL' } }, 13 | { term => { name => 'File-Changes-1.0' } }, 14 | ], 15 | }, 16 | }, 17 | ); 18 | 19 | is( $release->{name}, 'File-Changes-1.0', 'name ok' ); 20 | is( $release->{author}, 'LOCAL', 'author ok' ); 21 | is( $release->{version}, '1.0', 'version ok' ); 22 | is( $release->{main_module}, 'File::Changes', 'main_module ok' ); 23 | is( $release->{changes_file}, 'Changes', 'changes_file ok' ); 24 | 25 | { 26 | my @files = es_result( 27 | file => { 28 | term => { release => 'File-Changes-1.0' } 29 | } 30 | ); 31 | 32 | my ($changes) = grep { $_->{name} eq 'Changes' } @files; 33 | ok $changes, 'found Changes'; 34 | } 35 | 36 | done_testing; 37 | -------------------------------------------------------------------------------- /t/release/ipsonar-0.29.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Test::More; 8 | 9 | test_release( { 10 | name => 'IPsonar-0.29', 11 | distribution => 'IPsonar', 12 | 13 | author => 'LOCAL', 14 | authorized => true, 15 | first => true, 16 | 17 | # META file says ''. 18 | version => '', 19 | 20 | # Don't test the actual numbers since we copy this out of the real 21 | # database as a live test case. 22 | 23 | # This is kind of a SKIP. This may be an actual bug which we want to 24 | # investigate later. 25 | #tests => undef, 26 | } ); 27 | 28 | done_testing; 29 | -------------------------------------------------------------------------------- /t/release/local-lib.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Test::More; 8 | 9 | test_release( { 10 | name => 'local-lib-0.01', 11 | author => 'BORISNAT', 12 | abstract => 'Legitimate module', 13 | authorized => true, 14 | first => true, 15 | provides => ['local::lib'], 16 | main_module => 'local::lib', 17 | modules => { 18 | 'lib/local/lib.pm' => [ 19 | { 20 | name => 'local::lib', 21 | indexed => true, 22 | authorized => true, 23 | version => '0.01', 24 | version_numified => 0.01, 25 | associated_pod => 'BORISNAT/local-lib-0.01/lib/local/lib.pm', 26 | }, 27 | ], 28 | }, 29 | extra_tests => sub { 30 | my ($self) = @_; 31 | 32 | { 33 | my $file = $self->file_by_path('lib/local/lib.pm'); 34 | 35 | ok $file->{indexed}, 'local::lib should be indexed'; 36 | ok $file->{authorized}, 'local::lib should be authorized'; 37 | is $file->{sloc}, 3, 'sloc'; 38 | is $file->{slop}, 2, 'slop'; 39 | 40 | is_deeply $file->{pod_lines}, [ [ 4, 3 ] ], 'pod_lines'; 41 | 42 | is $file->{abstract}, q[Legitimate module], 'abstract'; 43 | } 44 | 45 | }, 46 | } ); 47 | 48 | done_testing; 49 | -------------------------------------------------------------------------------- /t/release/meta-license.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use Test::More; 7 | 8 | test_release( 9 | 'RWSTAUNER/Meta-License-Single-1.0', 10 | { 11 | license => [qw( mit )], 12 | main_module => 'Meta::License::Single', 13 | }, 14 | 'Meta file lists one license', 15 | ); 16 | 17 | test_release( 18 | 'RWSTAUNER/Meta-License-Dual-1.0', 19 | { 20 | license => [qw( perl_5 bsd )], 21 | main_module => 'Meta::License::Dual', 22 | }, 23 | 'Meta file lists two licenses', 24 | ); 25 | 26 | done_testing; 27 | -------------------------------------------------------------------------------- /t/release/no-modules.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Test::More; 8 | 9 | # Some uploads contain no usable modules. 10 | test_release( { 11 | name => 'No-Modules-1.1', 12 | author => 'BORISNAT', 13 | authorized => true, 14 | first => true, 15 | 16 | # Without modules it won't get marked as latest. 17 | status => 'cpan', 18 | 19 | provides => [ 20 | 21 | # empty 22 | ], 23 | modules => { 24 | 25 | # empty 26 | }, 27 | } ); 28 | 29 | done_testing; 30 | -------------------------------------------------------------------------------- /t/release/no-packages.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Test::More; 8 | 9 | # Some uploads contain no usable modules. 10 | test_release( { 11 | name => 'No-Packages-1.1', 12 | author => 'BORISNAT', 13 | authorized => true, 14 | first => true, 15 | 16 | # Without modules it won't get marked as latest. 17 | status => 'cpan', 18 | 19 | provides => [ 20 | 21 | # empty 22 | ], 23 | modules => { 24 | 25 | # empty 26 | }, 27 | } ); 28 | 29 | done_testing; 30 | -------------------------------------------------------------------------------- /t/release/p-1.0.20.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Ref::Util qw( is_hashref ); 8 | use Test::More; 9 | 10 | use MetaCPAN::TestServer (); 11 | 12 | my $server = MetaCPAN::TestServer->new; 13 | $server->index_cpantesters; 14 | 15 | test_release( { 16 | name => 'P-1.0.20', 17 | distribution => 'P', 18 | author => 'LOCAL', 19 | authorized => true, 20 | first => true, 21 | version => 'v1.0.20', 22 | 23 | provides => [ 'P', ], 24 | 25 | extra_tests => sub { 26 | my ($self) = @_; 27 | my $tests = $self->data->{tests}; 28 | 29 | # Don't test the actual numbers since we copy this out of the real 30 | # database as a live test case. 31 | 32 | ok( is_hashref($tests), 'hashref of tests' ); 33 | 34 | ok( $tests->{pass} > 0, 'has passed tests' ); 35 | 36 | ok( exists( $tests->{$_} ), "has '$_' results" ) 37 | for qw( pass fail na unknown ); 38 | }, 39 | } ); 40 | 41 | done_testing; 42 | -------------------------------------------------------------------------------- /t/release/perl-changes-file.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Server::Test qw( es_result ); 6 | use Test::More; 7 | 8 | my $release = es_result( 9 | release => { 10 | bool => { 11 | must => [ 12 | { term => { author => 'RWSTAUNER' } }, 13 | { term => { name => 'perl-1' } }, 14 | ], 15 | }, 16 | }, 17 | ); 18 | 19 | is( $release->{name}, 'perl-1', 'name ok' ); 20 | is( $release->{author}, 'RWSTAUNER', 'author ok' ); 21 | is( $release->{version}, '1', 'version ok' ); 22 | is( $release->{changes_file}, 'pod/perldelta.pod', 'changes_file ok' ); 23 | 24 | done_testing; 25 | -------------------------------------------------------------------------------- /t/release/pod-pm.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Server::Test qw( query ); 6 | use Test::More; 7 | 8 | my $query = query(); 9 | 10 | ok( my $pod_pm = $query->file->find_module('Pod::Pm'), 11 | 'find Pod::Pm module' ); 12 | 13 | is( $pod_pm->{name}, 'Pm.pm', 'defined in Pm.pm' ); 14 | 15 | is( 16 | $pod_pm->{module}->[0]->{associated_pod}, 17 | 'MO/Pod-Pm-0.01/lib/Pod/Pm.pod', 18 | 'has associated pod file' 19 | ); 20 | 21 | done_testing; 22 | -------------------------------------------------------------------------------- /t/release/some-trial.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Server::Test qw( es_result ); 6 | use Test::More; 7 | 8 | my $release = es_result( 9 | release => { 10 | bool => { 11 | must => [ 12 | { term => { author => 'LOCAL' } }, 13 | { term => { name => 'Some-1.00-TRIAL' } }, 14 | { term => { main_module => 'Some' } }, 15 | ], 16 | }, 17 | }, 18 | ); 19 | 20 | is( $release->{name}, 'Some-1.00-TRIAL', 'name ok' ); 21 | 22 | is( $release->{version}, '1.00-TRIAL', 'version with trial suffix' ); 23 | 24 | # although the author is not listed in the 06perms file but the 02packages.details file 25 | ok( $release->{authorized}, 'release is authorized' ); 26 | 27 | is_deeply $release->{tests}, 28 | { 29 | pass => 4, 30 | fail => 3, 31 | na => 2, 32 | unknown => 1, 33 | }, 34 | 'cpantesters results'; 35 | 36 | done_testing; 37 | -------------------------------------------------------------------------------- /t/release/text-tabs-wrap.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_distribution test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Test::More; 8 | 9 | test_distribution( 10 | 'Text-Tabs+Wrap', 11 | { 12 | bugs => { 13 | rt => { 14 | source => 15 | 'https://rt.cpan.org/Public/Dist/Display.html?Name=Text-Tabs%2BWrap', 16 | new => 2, 17 | open => 0, 18 | stalled => 0, 19 | patched => 0, 20 | resolved => 15, 21 | rejected => 1, 22 | active => 2, 23 | closed => 16, 24 | }, 25 | } 26 | }, 27 | 'rt url is uri escaped', 28 | ); 29 | 30 | test_release( { 31 | name => 'Text-Tabs+Wrap-2013.0523', 32 | 33 | distribution => 'Text-Tabs+Wrap', 34 | 35 | author => 'LOCAL', 36 | authorized => true, 37 | first => true, 38 | version => '2013.0523', 39 | 40 | # No modules. 41 | status => 'cpan', 42 | 43 | provides => [], 44 | } ); 45 | 46 | done_testing; 47 | -------------------------------------------------------------------------------- /t/release/versions.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Server::Test qw( query ); 6 | use Test::More; 7 | 8 | my $query = query(); 9 | 10 | my %modules = ( 11 | 'Versions::Our' => '1.45', 12 | 'Versions::PkgNameVersion' => '1.67', 13 | 'Versions::PkgNameVersionBlock' => '1.89', 14 | 'Versions::PkgVar' => '1.23', 15 | ); 16 | 17 | while ( my ( $module, $version ) = each %modules ) { 18 | 19 | ok( my $file = $query->file->find_module($module), "find $module" ) 20 | or next; 21 | 22 | ( my $path = "lib/$module.pm" ) =~ s/::/\//; 23 | is( $file->{path}, $path, 'expected path' ); 24 | 25 | # Check module version (different than dist version). 26 | is( $file->{module}->[0]->{version}, 27 | $version, 'version parsed from file' ); 28 | 29 | } 30 | 31 | done_testing; 32 | -------------------------------------------------------------------------------- /t/release/weblint++-1.15.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Test::More; 8 | 9 | test_release( { 10 | name => 'weblint++-1.15', 11 | 12 | # FIXME: Should we be stripping this? 13 | distribution => 'weblint', 14 | 15 | author => 'LOCAL', 16 | authorized => true, 17 | first => true, 18 | version => '1.15', 19 | 20 | # No modules. 21 | status => 'cpan', 22 | 23 | provides => [], 24 | 25 | tests => 1, 26 | 27 | extra_tests => sub { 28 | my ($self) = @_; 29 | 30 | { 31 | is $self->data->{distribution}, 'weblint', 32 | 'distribution matches META name, but strips out ++'; 33 | } 34 | }, 35 | } ); 36 | 37 | done_testing; 38 | -------------------------------------------------------------------------------- /t/release/www-tumblr-0.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::TestHelpers qw( test_release ); 6 | use MetaCPAN::Util qw(true false); 7 | use Test::More; 8 | 9 | test_release( { 10 | name => 'WWW-Tumblr-0', 11 | distribution => 'WWW-Tumblr', 12 | author => 'LOCAL', 13 | authorized => true, 14 | first => true, 15 | version => '0', 16 | 17 | provides => [ 'WWW::Tumblr', ], 18 | 19 | tests => 1, 20 | 21 | extra_tests => sub { 22 | my ($self) = @_; 23 | my $tests = $self->data->{tests}; 24 | 25 | my $content = $self->file_content('lib/WWW/Tumblr.pm'); 26 | like $content, qr/\$VERSION = ('?)0\1;/, 'version is zero'; 27 | }, 28 | } ); 29 | 30 | done_testing; 31 | 32 | -------------------------------------------------------------------------------- /t/script/cover.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use lib 't/lib'; 5 | 6 | use MetaCPAN::Script::Cover (); 7 | use MetaCPAN::Server::Config (); 8 | use MetaCPAN::Util qw( root_dir ); 9 | use Test::More; 10 | use URI (); 11 | 12 | my $root = root_dir(); 13 | my $file = URI->new('t/var/cover.json')->abs("file://$root/"); 14 | 15 | my $config = MetaCPAN::Server::Config::config(); 16 | $config->{cover_url} = "$file"; 17 | 18 | my $cover = MetaCPAN::Script::Cover->new_with_options($config); 19 | ok $cover->run, 'runs and returns true'; 20 | 21 | done_testing(); 22 | -------------------------------------------------------------------------------- /t/script/load.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use Test::More; 6 | 7 | ## no perlimports 8 | use MetaCPAN::Script::Author (); 9 | use MetaCPAN::Script::Backpan (); 10 | use MetaCPAN::Script::Backup (); 11 | use MetaCPAN::Script::Check (); 12 | use MetaCPAN::Script::Checksum (); 13 | use MetaCPAN::Script::Contributor (); 14 | use MetaCPAN::Script::Cover (); 15 | use MetaCPAN::Script::CPANTesters (); 16 | use MetaCPAN::Script::CPANTestersAPI (); 17 | use MetaCPAN::Script::External (); 18 | use MetaCPAN::Script::Favorite (); 19 | use MetaCPAN::Script::First (); 20 | use MetaCPAN::Script::Latest (); 21 | use MetaCPAN::Script::Mapping (); 22 | use MetaCPAN::Script::Mirrors (); 23 | use MetaCPAN::Script::Package (); 24 | use MetaCPAN::Script::Permission (); 25 | use MetaCPAN::Script::Purge (); 26 | use MetaCPAN::Script::Queue (); 27 | use MetaCPAN::Script::Release (); 28 | use MetaCPAN::Script::Restart (); 29 | use MetaCPAN::Script::River (); 30 | require MetaCPAN::Script::Role::Contributor; 31 | require MetaCPAN::Script::Role::External::Cygwin; 32 | require MetaCPAN::Script::Role::External::Debian; 33 | use MetaCPAN::Script::Runner (); 34 | use MetaCPAN::Script::Session (); 35 | use MetaCPAN::Script::Snapshot (); 36 | use MetaCPAN::Script::Suggest (); 37 | use MetaCPAN::Script::Tickets (); 38 | use MetaCPAN::Script::Watcher (); 39 | ## use perlimports 40 | 41 | pass 'all loaded Ok'; 42 | 43 | done_testing(); 44 | -------------------------------------------------------------------------------- /t/script/queue.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use MetaCPAN::Script::Queue (); 5 | use MetaCPAN::Server::Config (); 6 | use Test::More; 7 | 8 | my $config = MetaCPAN::Server::Config::config(); 9 | local @ARGV = ( '--dir', $config->{cpan} ); 10 | 11 | my $queue = MetaCPAN::Script::Queue->new_with_options($config); 12 | $queue->run; 13 | 14 | is( $queue->stats->{inactive_jobs}, 15 | 54, '54 files added to queue for indexing' ); 16 | 17 | done_testing(); 18 | -------------------------------------------------------------------------------- /t/script/river.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Script::River (); 6 | use MetaCPAN::Server::Test qw( app GET ); 7 | use MetaCPAN::TestHelpers qw( decode_json_ok ); 8 | use MetaCPAN::Util qw( root_dir ); 9 | use Plack::Test (); 10 | use Test::More; 11 | use URI (); 12 | 13 | my $config = MetaCPAN::Server::Config::config(); 14 | 15 | # local json file with structure from https://github.com/metacpan/metacpan-api/issues/460 16 | my $root = root_dir(); 17 | my $file = URI->new('t/var/river.json')->abs("file://$root/"); 18 | $config->{'river_url'} = "$file"; 19 | 20 | my $river = MetaCPAN::Script::River->new_with_options($config); 21 | ok $river->run, 'runs and returns true'; 22 | 23 | my %expect = ( 24 | 'System-Command' => { 25 | total => 92, 26 | immediate => 4, 27 | bucket => 2, 28 | }, 29 | 'Text-Markdown' => { 30 | total => 92, 31 | immediate => 56, 32 | bucket => 2, 33 | } 34 | ); 35 | 36 | my $test = Plack::Test->create( app() ); 37 | 38 | for my $dist ( keys %expect ) { 39 | my $expected = $expect{$dist}; 40 | subtest "Check $dist" => sub { 41 | my $url = "/distribution/$dist"; 42 | my $res = $test->request( GET $url ); 43 | diag "GET $url"; 44 | 45 | # TRAVIS 5.18 46 | is( $res->code, 200, "code 200" ); 47 | is( 48 | $res->header('content-type'), 49 | 'application/json; charset=utf-8', 50 | 'Content-type' 51 | ); 52 | my $json = decode_json_ok($res); 53 | 54 | # TRAVIS 5.18 55 | is_deeply( $json->{river}, $expected, 56 | "$dist river summary roundtrip" ); 57 | }; 58 | last; 59 | } 60 | 61 | done_testing(); 62 | -------------------------------------------------------------------------------- /t/server/controller/mirror.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Server::Test qw( app GET test_psgi ); 6 | use MetaCPAN::TestHelpers qw( decode_json_ok test_cache_headers ); 7 | use Test::More; 8 | 9 | my %tests = ( 10 | '/mirror' => { 11 | code => 200, 12 | cache_control => 'private', 13 | surrogate_key => 14 | 'content_type=application/json content_type=application', 15 | surrogate_control => undef, 16 | }, 17 | '/mirror/DOESNEXIST' => { 18 | code => 404, 19 | cache_control => 'private', 20 | surrogate_key => 21 | 'content_type=application/json content_type=application', 22 | surrogate_control => undef, 23 | }, 24 | '/mirror/search?q=*' => { 25 | code => 200, 26 | cache_control => 'private', 27 | surrogate_key => 28 | 'content_type=application/json content_type=application', 29 | surrogate_control => undef, 30 | }, 31 | ); 32 | 33 | test_psgi app, sub { 34 | my $cb = shift; 35 | for my $k ( sort keys %tests ) { 36 | my $v = $tests{$k}; 37 | ok( my $res = $cb->( GET $k ), "GET $k" ); 38 | is( $res->code, $v->{code}, "code " . $v->{code} ); 39 | is( 40 | $res->header('content-type'), 41 | 'application/json; charset=utf-8', 42 | 'Content-type' 43 | ); 44 | test_cache_headers( $res, $v ); 45 | 46 | decode_json_ok($res); 47 | } 48 | }; 49 | 50 | done_testing; 51 | -------------------------------------------------------------------------------- /t/server/controller/package.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use Cpanel::JSON::XS qw( decode_json ); 6 | use MetaCPAN::Server::Test qw( app GET test_psgi ); 7 | use MetaCPAN::TestServer (); 8 | use Test::More; 9 | 10 | my $server = MetaCPAN::TestServer->new; 11 | 12 | test_psgi app, sub { 13 | my $cb = shift; 14 | 15 | { 16 | my $module_name = 'CPAN::Test::Dummy::Perl5::VersionBump'; 17 | ok( my $res = $cb->( GET "/package/$module_name" ), 18 | "GET $module_name" ); 19 | is( $res->code, 200, '200 OK' ); 20 | 21 | is_deeply( 22 | decode_json( $res->content ), 23 | { 24 | module_name => $module_name, 25 | version => '0.02', 26 | file => 27 | 'M/MI/MIYAGAWA/CPAN-Test-Dummy-Perl5-VersionBump-0.02.tar.gz', 28 | author => 'MIYAGAWA', 29 | distribution => 'CPAN-Test-Dummy-Perl5-VersionBump', 30 | dist_version => '0.02', 31 | }, 32 | 'Has the correct 02packages info' 33 | ); 34 | } 35 | 36 | { 37 | my $dist = 'File-Changes-UTF8'; 38 | ok( my $res = $cb->( GET "/package/modules/$dist" ), 39 | "GET modules/$dist" ); 40 | is( $res->code, 200, '200 OK' ); 41 | is_deeply( 42 | decode_json( $res->content ), 43 | { 44 | modules => ['File::Changes::UTF8'], 45 | }, 46 | 'Can list modules of latest release' 47 | ); 48 | } 49 | }; 50 | 51 | done_testing; 52 | -------------------------------------------------------------------------------- /t/server/controller/permission.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use Cpanel::JSON::XS qw( decode_json ); 6 | use MetaCPAN::Server::Test qw( app GET test_psgi ); 7 | use MetaCPAN::TestServer (); 8 | use Test::More; 9 | 10 | my $server = MetaCPAN::TestServer->new; 11 | 12 | test_psgi app, sub { 13 | my $cb = shift; 14 | 15 | { 16 | my $module_name = 'CPAN::Test::Dummy::Perl5::VersionBump'; 17 | ok( my $res = $cb->( GET "/permission/$module_name" ), 18 | "GET $module_name" ); 19 | is( $res->code, 200, '200 OK' ); 20 | 21 | is_deeply( 22 | decode_json( $res->content ), 23 | { 24 | co_maintainers => ['OALDERS'], 25 | module_name => $module_name, 26 | owner => 'MIYAGAWA', 27 | }, 28 | 'Owned by MIYAGAWA, OALDERS has co-maint' 29 | ); 30 | } 31 | 32 | # Pod::Examples,RWSTAUNER,f 33 | { 34 | my $module_name = 'Pod::Examples'; 35 | ok( my $res = $cb->( GET "/permission/$module_name" ), 36 | "GET $module_name" ); 37 | is( $res->code, 200, '200 OK' ); 38 | 39 | is_deeply( 40 | decode_json( $res->content ), 41 | { 42 | co_maintainers => [], 43 | module_name => $module_name, 44 | owner => 'RWSTAUNER', 45 | }, 46 | 'Owned by RWSTAUNER, no co-maint' 47 | ); 48 | } 49 | }; 50 | 51 | done_testing; 52 | -------------------------------------------------------------------------------- /t/server/controller/root.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Server::Test qw( app GET test_psgi ); 6 | use Test::More; 7 | 8 | test_psgi app, sub { 9 | my $cb = shift; 10 | ok( my $res = $cb->( GET '/' ), "GET /" ); 11 | is( $res->code, 302, 'got redirect' ); 12 | is( 13 | $res->header('Location'), 14 | 'https://github.com/metacpan/metacpan-api/blob/master/docs/API-docs.md', 15 | 'correct redirect target' 16 | ); 17 | }; 18 | 19 | done_testing; 20 | -------------------------------------------------------------------------------- /t/server/not_found.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Server::Test qw( app GET test_psgi ); 6 | use MetaCPAN::TestHelpers qw( decode_json_ok ); 7 | use Test::More; 8 | 9 | my @tests = ( 10 | [ '/changes/LOCAL/File-Changes-2' => 404 ], 11 | [ '/changes/LOCAL/File-Changes-2.0' => 200 ], 12 | [ '/fakedoctype/andaction' => 404 ], 13 | [ '/file/LOCAL/File-Changes-2.0/Changes' => 200 ], 14 | [ '/file/LOCAL/File-Changes-2.0/NoChanges' => 404 ], 15 | [ '/release/File-Changes' => 200 ], 16 | [ '/release/No-Dist-Here' => 404 ], 17 | [ '/root.file' => 404 ], 18 | ); 19 | 20 | test_psgi app, sub { 21 | my $cb = shift; 22 | for my $test (@tests) { 23 | my ( $path, $code ) = @{$test}; 24 | 25 | ok( my $res = $cb->( GET $path ), "GET $path" ); 26 | is( $res->code, $code, "code $code" ); 27 | 28 | # 404 should still be json 29 | is( 30 | $res->header('content-type'), 31 | 'application/json; charset=utf-8', 32 | 'Content-type' 33 | ); 34 | my $json = decode_json_ok($res); 35 | 36 | next unless $res->code == 404; 37 | 38 | is( $json->{message}, 'Not found', '404 message as expected' ); 39 | is( $json->{code}, $code, 'code as expected' ); 40 | } 41 | }; 42 | 43 | done_testing; 44 | -------------------------------------------------------------------------------- /t/test-vars.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use Test::More; 6 | use Test::Vars import => [qw( vars_ok )]; 7 | 8 | vars_ok('MetaCPAN::Server'); 9 | 10 | done_testing(); 11 | -------------------------------------------------------------------------------- /t/testrules.yml: -------------------------------------------------------------------------------- 1 | --- 2 | seq: 3 | - seq: t/0*.t 4 | 5 | # ensure t/script/cover.t runs before t/server/controller/cover.t 6 | - seq: t/script/cover.t 7 | 8 | - par: 9 | - t/**.t 10 | -------------------------------------------------------------------------------- /t/var/cover.json: -------------------------------------------------------------------------------- 1 | { 2 | "MetaFile-Both" : { 3 | "1.1" : { 4 | "coverage" : { 5 | "total" : { 6 | "branch" : "12.50", 7 | "condition" : "0.00", 8 | "statement" : "63.64", 9 | "subroutine" : "71.43", 10 | "total" : "46.51" 11 | } 12 | } 13 | } 14 | }, 15 | "Pod-With-Generator" : { 16 | "1" : { 17 | "coverage" : { 18 | "total" : { 19 | "branch" : "78.95", 20 | "condition" : "46.67", 21 | "pod" : "100.00", 22 | "statement" : "95.06", 23 | "subroutine" : "100.00", 24 | "total" : "86.58" 25 | } 26 | } 27 | } 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /t/var/cpantesters-release-api-fake.json: -------------------------------------------------------------------------------- 1 | [{"fail":0,"na":0,"dist":"Devel-GoFaster","unknown":38,"version":"0.000","pass":468},{"version":"1.0.20","pass":194,"unknown":0,"dist":"P","na":9,"fail":14},{"unknown":0,"pass":267,"version":"0.29","na":8,"fail":5,"dist":"IPsonar"},{"fail":0,"na":0,"dist":"weblint","unknown":0,"version":"++-1.15","pass":26},{"dist":"WWW-Tumblr","na":1,"fail":0,"pass":0,"version":"","unknown":22},{"dist":"Some","fail":3,"na":2,"version":"1.00-TRIAL","pass":4,"unknown":1}] -------------------------------------------------------------------------------- /t/var/cpantesters-release-fake.db.bz2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metacpan/metacpan-api/0200d6169473b356a0ac3b16553a665c8bfe952d/t/var/cpantesters-release-fake.db.bz2 -------------------------------------------------------------------------------- /t/var/river.json: -------------------------------------------------------------------------------- 1 | [ 2 | { 3 | "dist": "System-Command", 4 | "total": 92, 5 | "immediate": 4, 6 | "bucket": 2 7 | }, 8 | { 9 | "dist": "Text-Markdown", 10 | "total": 92, 11 | "immediate": 56, 12 | "bucket": 2 13 | } 14 | ] 15 | -------------------------------------------------------------------------------- /templates/admin/identity_search_form.html.ep: -------------------------------------------------------------------------------- 1 |
2 | 3 | 9 | 10 | Identity value: 11 | 12 | 13 |
14 | -------------------------------------------------------------------------------- /templates/admin/index.html.ep: -------------------------------------------------------------------------------- 1 | 9 | -------------------------------------------------------------------------------- /templates/admin/search_identities.html.ep: -------------------------------------------------------------------------------- 1 | display results below: 2 | <%= stash('user_data')->{identity}[0]{name} %> 3 | <%= stash('user_data')->{identity}[0]{key} %> 4 | -------------------------------------------------------------------------------- /templates/layouts/default.html.ep: -------------------------------------------------------------------------------- 1 |

2 |
MetaCPAN Admin
3 |

4 | 5 | <%= content %> 6 | -------------------------------------------------------------------------------- /templates/queue/index_release.html.ep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metacpan/metacpan-api/0200d6169473b356a0ac3b16553a665c8bfe952d/templates/queue/index_release.html.ep -------------------------------------------------------------------------------- /test-data/fakecpan/00whois.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | MO 5 | author 6 | Moritz Onken 7 | onken@netcubed.de 8 | http://blog.netcubed.de 9 | 1 10 | 11 | 12 | MOFAKE 13 | author 14 | Moritz Onken 15 | onken@netcubed.de 16 | http://blog.netcubed.de 17 | 1 18 | 19 | 20 | DOY 21 | author 22 | Who Knows 23 | doy@cpan.org 24 | 1 25 | 26 | 27 | RWSTAUNER 28 | author 29 | Trouble Maker 30 | rwstauner@cpan.org 31 | 1 32 | 33 | 34 | BORISNAT 35 | author 36 | Лось и Белка 37 | Moose and Squirrel 38 | borisnat@cpan.org 39 | 1 40 | 41 | 42 | -------------------------------------------------------------------------------- /test-data/fakecpan/08pumpkings.txt.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metacpan/metacpan-api/0200d6169473b356a0ac3b16553a665c8bfe952d/test-data/fakecpan/08pumpkings.txt.gz -------------------------------------------------------------------------------- /test-data/fakecpan/author-1.0.json: -------------------------------------------------------------------------------- 1 | { 2 | "profile" : [ 3 | { 4 | "name" : "github", 5 | "id" : "monken" 6 | }, 7 | { 8 | "name" : "facebook", 9 | "id" : "moritz.onken" 10 | }, 11 | { 12 | "name" : "twitter", 13 | "id" : "moritzonken" 14 | } 15 | ], 16 | "country" : "DE", 17 | "website" : [ 18 | "http://metacpan.org/" 19 | ], 20 | "donation" : [ 21 | { 22 | "name" : "paypal", 23 | "id" : "onken@houseofdesign.de" 24 | } 25 | ], 26 | "perlmongers": { 27 | "name": "test.pm" 28 | }, 29 | "region" : "BW", 30 | "asciiname" : null, 31 | "name" : "Moritz Onken", 32 | "blog" : [ 33 | { 34 | "feed" : "http://blogs.perl.org/users/mo/atom.xml", 35 | "url" : "http://blogs.perl.org/users/mo/" 36 | }, 37 | { 38 | "feed" : "http://blog.netcubed.de/feed/", 39 | "url" : "http://blog.netcubed.de/" 40 | } 41 | ], 42 | "dir" : "id/P/PE/PERLER", 43 | "email" : [ 44 | "onken@netcubed.de" 45 | ], 46 | "city" : "Karlsruhe", 47 | "pauseid" : "PERLER" 48 | } -------------------------------------------------------------------------------- /test-data/fakecpan/bugs.tsv: -------------------------------------------------------------------------------- 1 | # A fake https://rt.cpan.org/Public/bugs-per-dist.tsv 2 | # dist new open stalled patched resolved rejected active inactive 3 | Monkey-Patch 0 0 0 0 1 0 0 1 4 | Moo 2 5 0 0 2 1 7 3 5 | Moose 15 20 4 0 122 23 39 145 6 | Text-Tabs+Wrap 2 0 0 0 15 1 2 16 7 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/MIYAGAWA_CPAN-Test-Dummy-Perl5-VersionBump-0.01.tar.gz.dist: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metacpan/metacpan-api/0200d6169473b356a0ac3b16553a665c8bfe952d/test-data/fakecpan/configs/MIYAGAWA_CPAN-Test-Dummy-Perl5-VersionBump-0.01.tar.gz.dist -------------------------------------------------------------------------------- /test-data/fakecpan/configs/MIYAGAWA_CPAN-Test-Dummy-Perl5-VersionBump-0.02.tar.gz.dist: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metacpan/metacpan-api/0200d6169473b356a0ac3b16553a665c8bfe952d/test-data/fakecpan/configs/MIYAGAWA_CPAN-Test-Dummy-Perl5-VersionBump-0.02.tar.gz.dist -------------------------------------------------------------------------------- /test-data/fakecpan/configs/badpod.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "BadPod", 3 | "abstract": "Distribution with malformed POD", 4 | "X_Module_Faker": { 5 | "cpan_author": "MO", 6 | "omitted_files": ["META.json", "META.yml"], 7 | "append": [ { 8 | "file": "lib/BadPod.pm", 9 | "content": "\n\n=head1 NAME\n\nBadPod - Malformed POD\n\n=head SYNOPSIS\n\nThere is no C 'Binary-Data', 4 | abstract => 'Binary after __DATA__ token', 5 | version => '0.01', 6 | 7 | # Specify provides so that both modules are included 8 | # in release 'provides' list and the release will get marked as latest. 9 | provides => { 10 | 'Binary::Data' => { 11 | file => 'lib/Binary/Data.pm', 12 | version => '0.01' 13 | }, 14 | 'Binary::Data::WithPod' => { 15 | file => 'lib/Binary/Data/WithPod.pm', 16 | version => '0.02' 17 | } 18 | }, 19 | 20 | X_Module_Faker => { 21 | cpan_author => 'BORISNAT', 22 | append => [ 23 | { 24 | file => 'lib/Binary/Data.pm', 25 | content => < 'lib/Binary/Data/WithPod.pm', 42 | 'content' => <