├── bin ├── queue.pl ├── cron │ ├── author.sh │ └── backups.sh ├── run ├── wait-for-open ├── mirror_cpan_for_developers.pl ├── metacpan ├── install-precious ├── api.pl ├── cpantesters_mini_db_for_testing ├── munin │ └── monitor_minion_queue.pl └── cpantesters_api_file_for_testing ├── .dockerignore ├── es ├── session │ ├── mapping.json │ └── settings.json ├── account │ ├── settings.json │ └── mapping.json ├── author │ └── settings.json ├── cover │ ├── settings.json │ └── mapping.json ├── cve │ ├── settings.json │ └── mapping.json ├── mirror │ └── settings.json ├── package │ ├── settings.json │ └── mapping.json ├── contributor │ ├── settings.json │ └── mapping.json ├── distribution │ └── settings.json ├── favorite │ ├── settings.json │ └── mapping.json ├── permission │ ├── settings.json │ └── mapping.json ├── settings.json ├── file │ └── settings.json └── release │ └── settings.json ├── root └── static │ └── favicon.ico ├── docs ├── debugging.md ├── authentication.md ├── dependencies.md ├── logging.md └── testing.md ├── git ├── setup.sh └── hooks │ └── pre-commit ├── t ├── var │ ├── cpantesters-release-fake.db.bz2 │ ├── river.json │ ├── cpantesters-release-api-fake.json │ └── cover.json ├── test-vars.t ├── testrules.yml ├── config.t ├── permission.t ├── package.t ├── document │ └── author.t ├── lib │ ├── MetaCPAN │ │ └── Tests │ │ │ ├── PSGI.pm │ │ │ ├── Distribution.pm │ │ │ ├── Extra.pm │ │ │ └── Controller │ │ │ └── Search │ │ │ └── DownloadURL.pm │ └── Module │ │ └── Faker │ │ └── Dist │ │ └── WithPerl.pm ├── script │ ├── queue.t │ ├── cover.t │ ├── load.t │ ├── river.t │ └── runner.t ├── release │ ├── pod-pm.t │ ├── meta-license.t │ ├── no-modules.t │ ├── no-packages.t │ ├── devel-gofaster-0.000.t │ ├── ipsonar-0.29.t │ ├── perl-changes-file.t │ ├── bugs.t │ ├── www-tumblr-0.t │ ├── weblint++-1.15.t │ ├── versions.t │ ├── some-trial.t │ ├── file-changes.t │ ├── p-1.0.20.t │ ├── documentation-not-readme.t │ ├── text-tabs-wrap.t │ ├── badpod.t │ ├── common-files.t │ └── local-lib.t ├── server │ ├── controller │ │ ├── root.t │ │ ├── permission.t │ │ ├── mirror.t │ │ └── package.t │ └── not_found.t ├── api │ └── queue.t ├── model │ ├── release.t │ ├── email │ │ └── pause.t │ └── release │ │ ├── metadata.t │ │ ├── reverse_dependencies.t │ │ └── dependencies.t ├── 01_darkpan.t ├── query │ └── release.t ├── pod │ └── renderer.t └── query.t ├── test-data └── fakecpan │ ├── 08pumpkings.txt.gz │ ├── configs │ ├── some-trial.json │ ├── devel-gofaster-0.000.yml │ ├── text-tabs+wrap-2013.0523.yml │ ├── MIYAGAWA_CPAN-Test-Dummy-Perl5-VersionBump-0.01.tar.gz.dist │ ├── MIYAGAWA_CPAN-Test-Dummy-Perl5-VersionBump-0.02.tar.gz.dist │ ├── www-tumblr-0.yml │ ├── no-modules.yml │ ├── meta-license-single.json │ ├── meta-license-dual.json │ ├── p-1.0.20.yml │ ├── file-changes-news.json │ ├── weblint++-1.15.yml │ ├── file-changes-1.json │ ├── file-changes-latin1.json │ ├── file-changes-utf8.json │ ├── badpod.json │ ├── local-lib.json │ ├── file-changes-2.json │ ├── no-packages.yml │ ├── moose.json │ ├── scripts.json │ ├── encoding-1.0.pl │ ├── encoding-1.2.pl │ ├── documentation-not-readme.json │ ├── perl-1.json │ ├── multiple-modules-tester.json │ ├── documentation-hide.json │ ├── pod-pm.json │ ├── multiple-modules-rdeps-0.11.json │ ├── multiple-modules-rdeps-2.03.json │ ├── multiple-modules-rdeps-a.json │ ├── metafile-yaml.json │ ├── uncommon-sense.json │ ├── multiple-modules-rdeps-deprecated.json │ ├── packages-unclaimable.json │ ├── common-files.yml │ ├── oops-locallib.json │ ├── encoding-1.1.pl │ ├── meta-provides-1.01.json │ ├── pod-with-generator.json │ ├── packages.json │ ├── pod-with-data-token.json │ ├── metafile-both.json │ ├── pod-examples.json │ ├── prereqs.json │ ├── metafile-json.json │ ├── moose-recent.json │ ├── prefer-meta-json.json │ ├── multiple-modules-0.1.json │ ├── versions.json │ ├── ipsonar-0.29.yml │ ├── multiple-modules-1.01.json │ └── binary-data.pl │ ├── bugs.tsv │ ├── author-1.0.json │ └── 00whois.xml ├── .github ├── dependabot.yml ├── workflows │ ├── automerge.yml │ ├── update-snapshot.yml │ ├── code-formatting.yml │ └── build-container.yml └── ISSUE_TEMPLATE.md ├── xt ├── README.txt └── search_web.t ├── lib ├── Catalyst │ └── Action │ │ └── Serialize │ │ └── MetaCPANSanitizedJSON.pm ├── MetaCPAN │ ├── Model │ │ ├── User │ │ │ ├── Session.pm │ │ │ ├── Identity.pm │ │ │ └── Account │ │ │ │ └── Set.pm │ │ ├── Hacks.pm │ │ └── ESWrapper.pm │ ├── Server │ │ ├── Role │ │ │ ├── JSONP.pm │ │ │ └── Request.pm │ │ ├── Controller │ │ │ ├── Search.pm │ │ │ ├── Cover.pm │ │ │ ├── Mirror.pm │ │ │ ├── Activity.pm │ │ │ ├── Search │ │ │ │ ├── History.pm │ │ │ │ ├── DownloadURL.pm │ │ │ │ ├── Autocomplete.pm │ │ │ │ └── Web.pm │ │ │ ├── Module.pm │ │ │ ├── Contributor.pm │ │ │ ├── Package.pm │ │ │ ├── Distribution.pm │ │ │ ├── Permission.pm │ │ │ ├── ReverseDependencies.pm │ │ │ ├── CVE.pm │ │ │ ├── File.pm │ │ │ ├── Login │ │ │ │ └── GitHub.pm │ │ │ └── User │ │ │ │ └── Favorite.pm │ │ ├── View │ │ │ ├── JSON.pm │ │ │ ├── JSONP.pm │ │ │ └── Pod.pm │ │ ├── Model │ │ │ ├── ES.pm │ │ │ ├── ESQuery.pm │ │ │ ├── Search.pm │ │ │ └── ESModel.pm │ │ ├── Action │ │ │ └── Deserialize.pm │ │ ├── User.pm │ │ ├── QuerySanitizer.pm │ │ └── Config.pm │ ├── Types.pm │ ├── API │ │ ├── Model │ │ │ ├── Role │ │ │ │ └── ES.pm │ │ │ └── User.pm │ │ ├── Controller │ │ │ └── Admin.pm │ │ └── Plugin │ │ │ └── Model.pm │ ├── Document │ │ ├── Dependency.pm │ │ ├── Package.pm │ │ ├── Permission.pm │ │ ├── Author │ │ │ └── Profile.pm │ │ ├── Cover.pm │ │ ├── Favorite.pm │ │ ├── Contributor.pm │ │ ├── Mirror.pm │ │ ├── CVE.pm │ │ └── Distribution.pm │ ├── Script │ │ ├── Restart.pm │ │ ├── Session.pm │ │ └── Queue.pm │ ├── Role │ │ ├── HasConfig.pm │ │ └── HasRogueDistributions.pm │ ├── Query │ │ ├── Cover.pm │ │ ├── Package.pm │ │ ├── Role │ │ │ └── Common.pm │ │ ├── CVE.pm │ │ ├── Permission.pm │ │ ├── Distribution.pm │ │ ├── Mirror.pm │ │ └── Contributor.pm │ ├── Model.pm │ └── Query.pm └── ElasticSearchX │ └── Model │ └── Document │ ├── Role.pm │ └── Set.pm ├── log4perl.conf ├── SECURITY.md ├── .gitignore ├── codecov.yml ├── .editorconfig ├── .perltidyrc ├── cpanfile.forced ├── metacpan_server.yaml ├── log4perl_prod.conf ├── metacpan_server_testing.yaml ├── .perlcriticrc ├── perlimports.toml ├── precious.toml ├── .circleci └── config.yml ├── wait-for-es.sh └── docker-compose.yml /bin/queue.pl: -------------------------------------------------------------------------------- 1 | api.pl -------------------------------------------------------------------------------- /.dockerignore: -------------------------------------------------------------------------------- 1 | .gitignore -------------------------------------------------------------------------------- /es/session/mapping.json: -------------------------------------------------------------------------------- 1 | { 2 | "dynamic": false 3 | } 4 | -------------------------------------------------------------------------------- /root/static/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metacpan/metacpan-api/HEAD/root/static/favicon.ico -------------------------------------------------------------------------------- /docs/debugging.md: -------------------------------------------------------------------------------- 1 | # Debugging 2 | 3 | To start the app in debug mode: 4 | 5 | METACPAN_SERVER_DEBUG=1 plackup 6 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/cover/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/cve/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/mirror/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/package/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/session/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /t/var/cpantesters-release-fake.db.bz2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metacpan/metacpan-api/HEAD/t/var/cpantesters-release-fake.db.bz2 -------------------------------------------------------------------------------- /test-data/fakecpan/08pumpkings.txt.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metacpan/metacpan-api/HEAD/test-data/fakecpan/08pumpkings.txt.gz -------------------------------------------------------------------------------- /es/contributor/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/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /es/permission/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "number_of_replicas": 1, 3 | "number_of_shards": 1, 4 | "refresh_interval": "1s" 5 | } 6 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/some-trial.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Some", 3 | "abstract": "A trial release", 4 | "version": "1.00-TRIAL" 5 | } 6 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/devel-gofaster-0.000.yml: -------------------------------------------------------------------------------- 1 | name: Devel-GoFaster 2 | # Floating point zero not treated the same as whole number zero. 3 | version: 0.000 4 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/text-tabs+wrap-2013.0523.yml: -------------------------------------------------------------------------------- 1 | name: Text-Tabs+Wrap 2 | version: 2013.0523 3 | provides: {} 4 | 5 | X_Module_Faker: 6 | omitted_files: 7 | - META.json 8 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /.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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/MIYAGAWA_CPAN-Test-Dummy-Perl5-VersionBump-0.01.tar.gz.dist: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/metacpan/metacpan-api/HEAD/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/HEAD/test-data/fakecpan/configs/MIYAGAWA_CPAN-Test-Dummy-Perl5-VersionBump-0.02.tar.gz.dist -------------------------------------------------------------------------------- /xt/README.txt: -------------------------------------------------------------------------------- 1 | # Tests in here are for development only 2 | 3 | # Setup port forwarding to our staging server 4 | ssh -L 9200:localhost:9200 leo@bm-mc-02.metacpan.org 5 | 6 | # Run tests - with ES env 7 | bin/prove_live xt/... 8 | -------------------------------------------------------------------------------- /bin/cron/author.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # export ES_SCRIPT_INDEX=author_01 4 | # /home/metacpan/bin/metacpan-api-carton-exec bin/metacpan author --index author_01 5 | 6 | /home/metacpan/bin/metacpan-api-carton-exec bin/metacpan author 7 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/www-tumblr-0.yml: -------------------------------------------------------------------------------- 1 | name: WWW-Tumblr 2 | version: 0 3 | 4 | X_Module_Faker: 5 | # For CPANTesters: A dist with version of '0'. 6 | omitted_files: 7 | - META.yml 8 | - META.json 9 | 10 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/no-modules.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: No-Modules 3 | version: 1.1 4 | abstract: An archive with no module files 5 | 6 | # Empty hash so Module::Faker won't build its own. 7 | provides: {} 8 | 9 | X_Module_Faker: 10 | cpan_author: BORISNAT 11 | -------------------------------------------------------------------------------- /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/meta-license-single.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Meta-License-Single", 3 | "abstract": "A dist with a single license", 4 | "version": "1.0", 5 | "license": [ "mit" ], 6 | "X_Module_Faker": { 7 | "cpan_author": "RWSTAUNER" 8 | } 9 | } 10 | -------------------------------------------------------------------------------- /git/hooks/pre-commit: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | declare -i status 4 | status=0 5 | 6 | PRECIOUS=$(which precious) 7 | if [[ -z $PRECIOUS ]]; then 8 | PRECIOUS=./bin/precious 9 | fi 10 | 11 | if ! "$PRECIOUS" lint -s; then 12 | status+=1 13 | fi 14 | 15 | exit $status 16 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/meta-license-dual.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Meta-License-Dual", 3 | "abstract": "A dist with multiple licenses", 4 | "version": "1.0", 5 | "license": [ "perl_5", "bsd" ], 6 | "X_Module_Faker": { 7 | "cpan_author": "RWSTAUNER" 8 | } 9 | } 10 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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/cron/backups.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | /home/metacpan/bin/metacpan-api-carton-exec bin/metacpan backup --index cpan_v1_01 --type favorite 4 | /home/metacpan/bin/metacpan-api-carton-exec bin/metacpan backup --index cpan_v1_01 --type author 5 | 6 | /home/metacpan/bin/metacpan-api-carton-exec bin/metacpan backup --index user 7 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/p-1.0.20.yml: -------------------------------------------------------------------------------- 1 | name: P 2 | version: 'v1.0.20' 3 | 4 | X_Module_Faker: 5 | # Live test case (https://github.com/metacpan/metacpan-web/issues/1046): 6 | # The archive basename doesn't have the 'v' in the version 7 | # but the META file does. 8 | archive_basename: 'P-1.0.20' 9 | cpan_author: 'LOCAL' 10 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/file-changes-news.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "File-Changes-News", 3 | "abstract": "A dist with a NEWS file", 4 | "version": "11.22", 5 | "X_Module_Faker": { 6 | "cpan_author": "LOCAL", 7 | "append": [ { 8 | "file": "NEWS", 9 | "content": "F\nR\nE\nE\nF\nO\nR\nM\n = text =\n" 10 | } ] 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/weblint++-1.15.yml: -------------------------------------------------------------------------------- 1 | name: weblint++ 2 | version: 1.15 3 | provides: {} 4 | 5 | X_Module_Faker: 6 | # Live test case with an unusual name. The ++ is part of the name 7 | # (according to the META file), 8 | # but CPAN::DistnameInfo parses it as part of the version. 9 | archive_basename: weblint++-1.15 10 | omitted_files: 11 | - META.json 12 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/file-changes-1.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "File-Changes", 3 | "abstract": "A dist with a Changes file", 4 | "version": "1.0", 5 | "X_Module_Faker": { 6 | "cpan_author": "LOCAL", 7 | "append": [ { 8 | "file": "Changes", 9 | "content": "Revision history for Changes\n\n1.0 2011-12-18T20:28:20Z\n - Initial Release\n" 10 | } ] 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/file-changes-latin1.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "File-Changes-Latin1", 3 | "abstract": "A dist with a Changes file in ISO 8859-1", 4 | "version": "1.0", 5 | "X_Module_Faker": { 6 | "cpan_author": "RWSTAUNER", 7 | "append": [ { 8 | "file": "Changes", 9 | "content": "1.0 2013-07-03T20:28:20Z\n - \u00a4 CURRENCY SIGN\n" 10 | } ] 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/file-changes-utf8.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "File-Changes-UTF8", 3 | "abstract": "A dist with a UTF-8 Changes file", 4 | "version": "1.0", 5 | "X_Module_Faker": { 6 | "cpan_author": "RWSTAUNER", 7 | "append": [ { 8 | "file": "Changes", 9 | "content": "1.0 2013-07-03T20:28:20Z\n - 23E7 \u23e7 ELECTRICAL INTERSECTION\n" 10 | } ] 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 Cmodel->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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /.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 | /bin/omegasort 14 | /bin/precious 15 | /bin/ubi 16 | /etc/metacpan_local.pl 17 | /t/var/darkpan/ 18 | /t/var/log/ 19 | /t/var/tmp/ 20 | *.komodoproject 21 | *.kpf 22 | *.sqlite* 23 | *.sw* 24 | .DS_Store 25 | .tidyall.d 26 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/no-packages.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: No-Packages 3 | version: 1.1 4 | abstract: An archive with pm files but no parseable packages 5 | 6 | # Empty hash so Module::Faker won't build its own. 7 | provides: {} 8 | 9 | X_Module_Faker: 10 | cpan_author: BORISNAT 11 | 12 | append: 13 | - 14 | file: NoPackages.pm 15 | content: | 16 | use Something; 17 | # no package statements 18 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/moose.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Moose", 3 | "abstract": "A standard perl distribution", 4 | "X_Module_Faker": { 5 | "cpan_author": "DOY", 6 | "mtime": 1382574136, 7 | "append": [ { 8 | "file": "lib/Moose.pm", 9 | "content": "\n\n=head1 NAME\n\nMoose - abstract" 10 | }, { 11 | "file": "Changes", 12 | "content": "2012-01-01 0.01 First release - codename 'M\u00FCnchen'\n" 13 | } ] 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /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}] -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/scripts.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Scripts", 3 | "abstract": "contains various scripts that should be declared as such", 4 | "X_Module_Faker": { 5 | "cpan_author": "MO", 6 | "append": [ { 7 | "file": "bin/catalyst.pl", 8 | "content": "#!/usr/bin/env perl\n\n=head1 NAME\n\ncatalyst - starter" 9 | }, { 10 | "file": "bin/starman", 11 | "content": "#!/usr/bin/perl\n\n=head1 NAME\n\nstarman - starter" 12 | } ] 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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/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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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/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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/encoding-1.0.pl: -------------------------------------------------------------------------------- 1 | { 2 | "name" => "Encoding", 3 | "abstract" => "Beyond 7bit ascii", 4 | "version" => "1.0", 5 | "X_Module_Faker" => { 6 | "cpan_author" => "RWSTAUNER", 7 | "omitted_files" => [ "META.json", "META.yml" ], 8 | "append" => [ 9 | { 10 | "file" => "lib/Encoding/CP1252.pm", 11 | "content" => 12 | "package Encoding::CP1252;\n\nsub bullet { qq<\x{95}> }\n", 13 | }, 14 | ], 15 | }, 16 | } 17 | -------------------------------------------------------------------------------- /.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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/encoding-1.2.pl: -------------------------------------------------------------------------------- 1 | { 2 | "name" => "Encoding", 3 | "abstract" => "Beyond 7bit ascii", 4 | "version" => "1.2", 5 | "X_Module_Faker" => { 6 | "cpan_author" => "RWSTAUNER", 7 | "omitted_files" => [ "META.json", "META.yml" ], 8 | "append" => [ 9 | { 10 | "file" => "lib/Encoding/UTF8.pm", 11 | "content" => 12 | "package Encoding::UTF8;\n\nuse utf8;\nmy \$heart = qq<\342\231\245>;\n", 13 | }, 14 | ], 15 | }, 16 | } 17 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/documentation-not-readme.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Documentation-Not-Readme", 3 | "abstract": "A dist with a README.pod that should *not* be considered the main module documentation.", 4 | "X_Module_Faker": { 5 | "cpan_author": "RWSTAUNER", 6 | "append": [ { 7 | "file": "README.pod", 8 | "content": "=head1 NAME\n\nDocumentation::Not::Readme - this is not it\n" 9 | }, { 10 | "file": "lib/Documentation/Not/Readme.pm", 11 | "content": "=head1 NAME\n\nDocumentation::Not::Readme - the real abstract\n" 12 | } ] 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /.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 | -------------------------------------------------------------------------------- /bin/metacpan: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | =head1 SYNOPSIS 4 | 5 | # sample usage 6 | 7 | bin/metacpan release /path/to/cpan/authors/id/ 8 | bin/metacpan release /path/to/cpan/authors/id/{A,B} 9 | bin/metacpan release /path/to/cpan/authors/id/D/DO/DOY/Try-Tiny-0.09.tar.gz 10 | bin/metacpan latest 11 | bin/metacpan server --cpan /path/to/cpan/ 12 | 13 | =cut 14 | 15 | use strict; 16 | use warnings; 17 | use FindBin (); 18 | use lib "$FindBin::RealBin/../lib"; 19 | use MetaCPAN::Script::Runner (); 20 | 21 | MetaCPAN::Script::Runner->run; 22 | 23 | exit $MetaCPAN::Script::Runner::EXIT_CODE; 24 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/perl-1.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "perl", 3 | "version": 1, 4 | "abstract": "perl release", 5 | "X_Module_Faker": { 6 | "cpan_author": "RWSTAUNER", 7 | "append": [ { 8 | "file": "pod/perldelta.pod", 9 | "content": "\n\n=head1 NAME\n\nperldelta - changes for perl\n\n" 10 | }, 11 | { 12 | "file": "lib/CoreModule.pm", 13 | "content": "package CoreModule;\n1; \n\n=head1 NAME\n\nCoreModule - something in perl core\n\n" 14 | }, 15 | { 16 | "file": "Changes", 17 | "content": "See perldelta.pod" 18 | } ] 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /bin/install-precious: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | # This is for installing precious and other 3rd party libs needed for linting 4 | # in CI 5 | 6 | set -euo pipefail 7 | 8 | if [ -z "${1:-}" ]; then 9 | echo "usage: ./bin/install-precious /path/to/bin/dir" 10 | exit 1 11 | fi 12 | 13 | TARGET=$1 14 | export TARGET 15 | 16 | TARGET=$1 17 | export TARGET 18 | 19 | curl --silent --location \ 20 | https://raw.githubusercontent.com/houseabsolute/ubi/master/bootstrap/bootstrap-ubi.sh | 21 | sh 22 | 23 | ubi --project houseabsolute/omegasort --in "$TARGET" 24 | ubi --project houseabsolute/precious --in "$TARGET" 25 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/multiple-modules-tester.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Multiple-Modules-Tester", 3 | "abstract": "A dist that Multiple::Modules::* can use for testing", 4 | "version": 0.96, 5 | "meta-spec": { 6 | "version": 1.3 7 | }, 8 | "X_Module_Faker": { 9 | "cpan_author": "LOCAL", 10 | "append": [ { 11 | "file": "lib/Multiple/Modules/Tester.pm", 12 | "content": "package Multiple::Modules::Tester;\n1;\n\n=head1 NAME\n\nMultiple::Modules::Tester - abstract" 13 | }, 14 | { 15 | "file": "t/foo.t", 16 | "content": "use Test::More;" 17 | } ] 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/documentation-hide.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Documentation-Hide", 3 | "abstract": ".pm file with hidden package declaration and name section", 4 | "X_Module_Faker": { 5 | "cpan_author": "MO", 6 | "omitted_files": ["META.json", "META.yml"], 7 | "append": [ { 8 | "file": "lib/Documentation/Hide.pm", 9 | "content": "\npackage\nDocumentation::Hide::Internal;\n\n=head1 NAME\n\nDocumentation::Hide::Internal - abstract\n" 10 | }, { 11 | "file": "lib/Documentation/Hide/Doc.pod", 12 | "content": "=head1 NAME\n\nDocumentation::Hide::Doc - abstract\n" 13 | } ] 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/pod-pm.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Pod-Pm", 3 | "abstract": "Distribution with documentation in .pod", 4 | "X_Module_Faker": { 5 | "cpan_author": "MO", 6 | "append": [ { 7 | "file": "lib/Pod/Pm.pod", 8 | "content": "\n\n=head1 NAME\n\nPod::Pm - abstract" 9 | },{ 10 | "file": "lib/Pod/Pm.pm", 11 | "content": "\n\n=head1 NAME\n\nPod::Pm - foo" 12 | },{ 13 | "file": "lib/Pod/Pm/NoPod.pm", 14 | "content": "1;" 15 | },{ 16 | "file": "lib/Pod/Pm/NoPod.pod", 17 | "content": "\n\n=head1 NAME\n\nPod::Pm::NoPod - foo" 18 | } ] 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/multiple-modules-rdeps-0.11.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Multiple-Modules-RDeps", 3 | "abstract": "A dist that depends on Multiple::Modules", 4 | "version": 0.11, 5 | "meta-spec": { 6 | "version": 1.3 7 | }, 8 | "requires": { 9 | "Multiple::Modules": 0 10 | }, 11 | "X_Module_Faker": { 12 | "cpan_author": "LOCAL", 13 | "append": [ { 14 | "file": "lib/Multiple/Modules/RDeps.pm", 15 | "content": "use Multiple::Modules;\n1;\n\n=head1 NAME\n\nMultiple::Modules::RDeps - abstract" 16 | }, 17 | { 18 | "file": "t/foo.t", 19 | "content": "use Test::More;" 20 | } ] 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/multiple-modules-rdeps-2.03.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Multiple-Modules-RDeps", 3 | "abstract": "A dist that depends on Multiple::Modules", 4 | "version": 2.03, 5 | "meta-spec": { 6 | "version": 1.3 7 | }, 8 | "requires": { 9 | "Multiple::Modules": 0 10 | }, 11 | "X_Module_Faker": { 12 | "cpan_author": "LOCAL", 13 | "append": [ { 14 | "file": "lib/Multiple/Modules/RDeps.pm", 15 | "content": "use Multiple::Modules;\n1;\n\n=head1 NAME\n\nMultiple::Modules::RDeps - abstract" 16 | }, 17 | { 18 | "file": "t/foo.t", 19 | "content": "use Test::More;" 20 | } ] 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/multiple-modules-rdeps-a.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Multiple-Modules-RDeps-A", 3 | "abstract": "A dist that depends on Multiple::Modules::A", 4 | "version": 2.03, 5 | "meta-spec": { 6 | "version": 1.3 7 | }, 8 | "requires": { 9 | "Multiple::Modules::A": 0 10 | }, 11 | "X_Module_Faker": { 12 | "cpan_author": "LOCAL", 13 | "append": [ { 14 | "file": "lib/Multiple/Modules/RDeps/A.pm", 15 | "content": "use Multiple::Modules::A;\n1;\n\n=head1 NAME\n\nMultiple::Modules::RDeps::A - abstract" 16 | }, 17 | { 18 | "file": "t/foo.t", 19 | "content": "use Test::More;" 20 | } ] 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /cpanfile.forced: -------------------------------------------------------------------------------- 1 | # transitive deps 2 | # Not used directly, but they need to be explicitly listed to ensure they are 3 | # in our cpanfile.snapshot at appropriate versions. Either for older perl 4 | # versions, or unpredictable dynamic deps. These will be installed using a 5 | # different process to ensure they are present in the snapshot, even if they 6 | # would be satisfied by core. 7 | requires 'CPAN::Meta', '2.141520'; 8 | requires 'Devel::PPPort', '3.62'; # for older perls 9 | requires 'ExtUtils::MakeMaker', '7.76'; 10 | requires 'version', '0.9929'; # for older perls 11 | requires 'Module::Signature', '0.90'; 12 | requires 'Pod::Parser', '1.67'; # for newer perls 13 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/metafile-yaml.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "MetaFile-YAML", 3 | "abstract": "A dist with just META.yml", 4 | "version": 1.1, 5 | "X_Module_Faker": { 6 | "cpan_author": "LOCAL", 7 | "omitted_files": [ "META.yml", "META.json" ], 8 | "append": [ { 9 | "file": "lib/MetaFile/YAML.pm", 10 | "content": "package MetaFile::YAML;\n\n=head1 NAME\n\nMetaFile::YAML - abstract" 11 | }, 12 | { 13 | "file": "META.yml", 14 | "content": "---\ngenerated_by: 'Module::Faker append'\nversion: 1.1\nname: MetaFile-YAML" 15 | }, 16 | { 17 | "file": "t/foo.t", 18 | "content": "use Test::More;" 19 | } ] 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/uncommon-sense.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "uncommon-sense", 3 | "abstract": "Distribution with .pm.PL file", 4 | "version": "0.01", 5 | "x_comment": "Module::Faker will create a lib/*.pm file to match the dist name (uncommon::sense) so we'll use a different package to test `.pm.PL`.", 6 | "X_Module_Faker": { 7 | "cpan_author": "MO", 8 | "omitted_files": ["META.json", "META.yml"], 9 | "append": [ { 10 | "file": "sense.pm.PL", 11 | "content": "#! perl-000\n\nour $VERSION = '4.56';\n\n__DATA__\npackage less::sense;" 12 | },{ 13 | "file": "sense.pod", 14 | "content": "\n\n=head1 NAME\n\nless::sense - I'm special" 15 | }] 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/multiple-modules-rdeps-deprecated.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Multiple-Modules-RDeps-Deprecated", 3 | "abstract": "A dist that depends on Multiple::Modules::Deprecated", 4 | "version": 0.01, 5 | "meta-spec": { 6 | "version": 1.3 7 | }, 8 | "requires": { 9 | "Multiple::Modules::Deprecated": 0 10 | }, 11 | "X_Module_Faker": { 12 | "cpan_author": "LOCAL", 13 | "append": [ { 14 | "file": "lib/Multiple/Modules/RDeps/Deprecated.pm", 15 | "content": "use Multiple::Modules;\n1;\n\n=head1 NAME\n\nMultiple::Modules::RDeps::Deprecated - abstract" 16 | }, 17 | { 18 | "file": "t/foo.t", 19 | "content": "use Test::More;" 20 | } ] 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /t/api/queue.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use Test::More skip_all => 'disabling Minion tests to avoid needing postgres'; 6 | use MetaCPAN::DarkPAN (); 7 | use Path::Tiny qw( path ); 8 | use Test::Mojo; 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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/packages-unclaimable.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Packages-Unclaimable", 3 | "abstract": "See module pod (no META file)", 4 | "version": "2", 5 | "X_Module_Faker": { 6 | "cpan_author": "RWSTAUNER", 7 | "omit_files_comment": "Omit META files so that we parse files/modules instead of trusting the provides metadata", 8 | "omitted_files": ["META.json", "META.yml"], 9 | "append": [ { 10 | "file": "lib/Packages/Unclaimable.pm", 11 | "content": "package Packages::Unclaimable;\nour $VERSION = 2;\n\n while(1) {\n\tpackage DB;\n\tprint STDERR caller();\n}\npackage main;\nprint \"hello!\";\n=head1 NAME\n\nPackages::Unclaimable - Dist that appears to declare packages that are not allowed\n" 12 | } ] 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/common-files.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: Common-Files 3 | version: 1.1 4 | abstract: Test common archive files 5 | 6 | X_Module_Faker: 7 | cpan_author: BORISNAT 8 | omitted_files: 9 | - Makefile.PL 10 | 11 | append: 12 | - 13 | file: lib/Common/Files.pm 14 | content: | 15 | =head1 NAME 16 | 17 | Common::Files - testing common files in a release 18 | 19 | =cut 20 | 21 | - 22 | file: Makefile.PL 23 | # NOTE: YAML::Tiny (CPAN::Meta::YAML) strips the blank lines. 24 | content: | 25 | print "hi"; 26 | 27 | =pod 28 | 29 | some pod 30 | 31 | =cut 32 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/oops-locallib.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Oops-LocalLib", 3 | "version": "0.01", 4 | "abstract": "Shipped a dist with a local lib", 5 | "X_Module_Faker": { 6 | "cpan_author": "BORISNAT", 7 | "omitted_files": ["META.json", "META.yml"], 8 | "append": [ { 9 | "file": "lib/Oops/LocalLib.pm", 10 | "content": "# Module::Faker\n=head1 NAME\n\nOops::LocalLib - accidentally shipped a local lib dir\n" 11 | }, { 12 | "file": "local/Vegetable.pm", 13 | "content": "\npackage Vegetable;\nour $VERSION = 1;\n\n=head1 NAME\n\nVegetable - should not have been included\n" 14 | }, { 15 | "file": "foreign/Fruits.pm", 16 | "content": "package Fruits;\nour $VERSION = 1;\n\n=head1 NAME\n\nFruits - yum\n" 17 | } ] 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/encoding-1.1.pl: -------------------------------------------------------------------------------- 1 | { 2 | "name" => "Encoding", 3 | "abstract" => "Beyond 7bit ascii", 4 | "version" => "1.1", 5 | "X_Module_Faker" => { 6 | "cpan_author" => "RWSTAUNER", 7 | "omitted_files" => [ "META.json", "META.yml" ], 8 | "append" => [ 9 | { 10 | "file" => "lib/Encoding/UTF8.pm", 11 | "content" => 12 | "package Encoding::UTF8;\n\nuse utf8;\nmy \$heart = qq<\342\235\244>;\n", 13 | }, 14 | { 15 | "file" => "lib/Encoding/CP1252.pm", 16 | "content" => 17 | "package Encoding::CP1252;\n\nsub bullet { qq<\x95-\xf7> }\n", 18 | }, 19 | ], 20 | }, 21 | } 22 | -------------------------------------------------------------------------------- /.github/workflows/automerge.yml: -------------------------------------------------------------------------------- 1 | name: Enable Auto-Merge For bots 2 | on: 3 | pull_request_target: 4 | types: [opened] 5 | 6 | jobs: 7 | enable-auto-merge: 8 | runs-on: ubuntu-latest 9 | if: > 10 | github.event.pull_request.user.login == 'metacpan-automation[bot]' 11 | || github.event.pull_request.user.login == 'dependabot[bot]' 12 | steps: 13 | - name: Generate Auth Token 14 | uses: actions/create-github-app-token@v2 15 | id: app-token 16 | with: 17 | app-id: ${{ secrets.APP_ID }} 18 | private-key: ${{ secrets.APP_PRIVATE_KEY }} 19 | - uses: peter-evans/enable-pull-request-automerge@v3 20 | with: 21 | token: ${{ steps.app-token.outputs.token }} 22 | pull-request-number: ${{ github.event.pull_request.number }} 23 | -------------------------------------------------------------------------------- /metacpan_server.yaml: -------------------------------------------------------------------------------- 1 | --- 2 | git: /usr/bin/git 3 | 4 | cpan: /CPAN 5 | remote_cpan: https://cpan.metacpan.org/ 6 | secret: "the stone roses" 7 | level: info 8 | elasticsearch_servers: 9 | client: '2_0::Direct' 10 | nodes: http://elasticsearch:9200 11 | minion_dsn: "postgresql://metacpan:t00lchain@pghost:5432/minion_queue" 12 | port: 5000 13 | 14 | logger: 15 | class: Log::Log4perl::Appender::File 16 | filename: ../var/log/metacpan.log 17 | syswrite: 1 18 | 19 | smtp: 20 | host: smtp.fastmail.com 21 | port: 465 22 | username: foo@metacpan.org 23 | password: seekrit 24 | 25 | oauth: 26 | github: 27 | key: seekrit 28 | secret: seekrit 29 | google: 30 | key: seekrit 31 | secret: seekrit 32 | twitter: 33 | key: seekrit 34 | secret: seekrit 35 | 36 | front_end_url: http://0.0.0.0:5001 37 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /metacpan_server_testing.yaml: -------------------------------------------------------------------------------- 1 | git: /usr/bin/git 2 | cpan: var/t/tmp/fakecpan 3 | remote_cpan: file://__HOME__/var/t/tmp/fakecpan 4 | die_on_error: 1 5 | level: warn 6 | port: 5000 7 | source_base: var/t/tmp/source 8 | 9 | elasticsearch_servers: 10 | client: '2_0::Direct' 11 | nodes: ${ES:-http://elasticsearch_test:9200} 12 | 13 | minion_dsn: "postgresql://metacpan:t00lchain@pghost:5432/minion_queue" 14 | 15 | logger: 16 | class: Log::Log4perl::Appender::Screen 17 | name: testing 18 | 19 | secret: weak 20 | 21 | smtp: 22 | host: smtp.fastmail.com 23 | port: 465 24 | username: foo@metacpan.org 25 | password: seekrit 26 | 27 | oauth: 28 | github: 29 | key: seekrit 30 | secret: seekrit 31 | google: 32 | key: seekrit 33 | secret: seekrit 34 | twitter: 35 | key: seekrit 36 | secret: seekrit 37 | 38 | front_end_url: http://0.0.0.0:5001 39 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/meta-provides-1.01.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Meta-Provides", 3 | "version": 1.01, 4 | "X_Module_Faker": { 5 | "cpan_author": "RWSTAUNER", 6 | "append": [ { 7 | "file": "lib/Meta/Provides.pm", 8 | "content": "package Meta::Provides;\n\n=head1 NAME\n\nMeta::Provides - has provides key in meta" 9 | }, 10 | { 11 | "file": "lib/Meta/Provides/NotSpecified.pm", 12 | "content": "package Meta::Provides::NotSpecified;\n\n=head1 NAME\n\nMeta::Provides::NotSpecified - not specified in provides section" 13 | }, 14 | { 15 | "file": "t/foo.t", 16 | "content": "use Test::More;" 17 | } ] 18 | }, 19 | "generated_by": "hand", 20 | "abstract": "", 21 | "provides": { 22 | "Meta::Provides": { 23 | "file": "lib/Meta/Provides.pm", 24 | "version": "0.321" 25 | } 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /.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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/pod-with-generator.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Pod-With-Generator", 3 | "version": "1", 4 | "abstract": "Pod file with generator in dist", 5 | "provides": { 6 | "Pod::With::Generator": { 7 | "file": "lib/Pod/With/Generator.pm", 8 | "version": "1" 9 | } 10 | }, 11 | "X_Module_Faker": { 12 | "cpan_author": "BORISNAT", 13 | "append": [ { 14 | "file": "lib/Pod/With/Generator.pm", 15 | "content": "# Module::Faker should prepend 3 lines above this\n\n=head1 NAME\n\nPod::With::Generator - this pod is generated\n\n=head1 Truth\n\nbut this is the real one!\n\n=cut\n" 16 | }, 17 | { 18 | "file": "config/doc_gen.pm", 19 | "content": "# i generate the pods.\n\nset <;\n __DATA__\n More text\n\n=head1 DESCRIPTION\n\ndata handle inside pod is pod but not data\n\n__DATA__\n\nsee?\n\n=cut\n\nprint \"hi\\n\";\n\nprint map { \" | $_\" } ;\n\n=head2 EVEN MOAR\n\nnot much, though\n\n=cut\n\n__DATA__\n\ndata is here\n\n__END__\n\nTHE END IS NEAR\n\n\n=pod\n\nthis is pod to a pod reader but DATA to perl\n" 10 | } ] 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/metafile-both.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "MetaFile-Both", 3 | "abstract": "A dist with META.yml and META.json", 4 | "version": 1.1, 5 | "X_Module_Faker": { 6 | "cpan_author": "LOCAL", 7 | "omitted_files": ["META.json"], 8 | "append": [ { 9 | "file": "lib/MetaFile/Both.pm", 10 | "content": "package MetaFile::Both;\n\n=head1 NAME\n\nMetaFile::Both - abstract" 11 | }, 12 | { 13 | "file": "META.json", 14 | "content": "{\"meta-spec\":{\"version\":2,\"url\":\"http://search.cpan.org/perldoc?CPAN::Meta::Spec\"},\"generated_by\":\"hand\",\"version\":1.1,\"name\":\"MetaFile-Both\",\"dynamic_config\":0,\"author\":\"LOCAL\",\"license\":\"unknown\",\"abstract\":\"A dist with META.yml and META.json\",\"release_status\":\"stable\",\"x_meta_file\":\"json\"}" 15 | }, 16 | { 17 | "file": "t/foo.t", 18 | "content": "use Test::More;" 19 | } ] 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/pod-examples.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Pod-Examples", 3 | "abstract": "Various examples of pod usage", 4 | "version": "99", 5 | "X_Module_Faker": { 6 | "cpan_author": "RWSTAUNER", 7 | "append": [ { 8 | "file": "Changes", 9 | "content": "Revision history for Changes\n\n99.0 2015-03-12T20:28:20Z\n - Initial Release\n" 10 | },{ 11 | "file": "lib/Pod/Examples/Spacial.pod", 12 | "content": "=head1 NAME\n\nPod::Examples::Spacial\n\n=head1 DESCRIPTION\n\nAn extra space between 'head1' and 'NAME'\n" 13 | }, { 14 | "file": "lib/Pod/Examples/XCodes.pm", 15 | "content": "package Pod::Examples::XCodes;\nour $VERSION = 1;\n\n=head1 NAME\n\nPod::Examples::XCodes\n\n=head1 DESCRIPTION\nX\n\nA doc with X codes\n" 16 | }, 17 | { 18 | "file": "lib/Changelog", 19 | "content": "Log for Changes\n\n99.0 2015-03-12T20:28:20Z\n - Initial Release\n" 20 | }] 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/prereqs.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Prereqs-Basic", 3 | "abstract": "A perl module with prereqs", 4 | "version": 0.01, 5 | "prereqs": { 6 | "build": { 7 | "requires": { 8 | "For::Build::Requires1": 2.45 9 | } 10 | }, 11 | "configure": { 12 | "requires": { 13 | "For::Configure::Requires1": 72 14 | } 15 | }, 16 | "runtime": { 17 | "requires": { 18 | "For::Runtime::Requires1": 0, 19 | "For::Runtime::Requires2": 1.23 20 | }, 21 | "recommends": { 22 | "For::Runtime::Recommends1": 0 23 | } 24 | } 25 | }, 26 | "X_Module_Faker": { 27 | "cpan_author": "MSCHWERN", 28 | "append": [{ 29 | "file": "lib/Prereqs/Basic.pm", 30 | "content": "package Prereqs::Basic; 1;" 31 | }] 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/metafile-json.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "MetaFile-JSON", 3 | "abstract": "A dist with just META.json", 4 | "version": 1.1, 5 | "X_Module_Faker": { 6 | "cpan_author": "LOCAL", 7 | "omitted_files": [ "META.json", "META.yml" ], 8 | "append": [ { 9 | "file": "lib/MetaFile/JSON.pm", 10 | "content": "package MetaFile::JSON;\n\n=head1 NAME\n\nMetaFile::JSON - abstract" 11 | }, 12 | { 13 | "file": "META.json", 14 | "content": "{\"resources\":{\"bugtracker\":{\"web\":\"https://github.com/metacpan/metacpan-api/issues\"}},\"meta-spec\":{\"version\":2,\"url\":\"http://search.cpan.org/perldoc?CPAN::Meta::Spec\"},\"generated_by\":\"hand\",\"version\":1.1,\"name\":\"MetaFile-JSON\",\"dynamic_config\":0,\"author\":\"LOCAL\",\"license\":\"unknown\",\"abstract\":\"A dist with META.yml and META.json\",\"release_status\":\"stable\",\"x_meta_file\":\"json\"}" 15 | }, 16 | { 17 | "file": "t/foo.t", 18 | "content": "use Test::More;" 19 | } ] 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/moose-recent.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Moose", 3 | "abstract": "A standard perl distribution", 4 | "version": 0.02, 5 | "X_Module_Faker": { 6 | "cpan_author": "DOY", 7 | "mtime": 1382574137, 8 | "append": [ { 9 | "file": "lib/Moose.pm", 10 | "content": "\n\n=head1 NAME\n\nMoose - abstract" 11 | }, 12 | { 13 | "file": "t/foo.t", 14 | "content": "use Test::More;" 15 | }, 16 | { 17 | "file": "lib/Moose/FAQ.pm", 18 | "content": "1; \n\n=head1 NAME\n\nMoose::FAQ - abstract" 19 | }, 20 | { 21 | "file": "parts/inc/ppphdoc", 22 | "content": "\n\n=head1 NAME\n\nppport.h - Perl/Pollution/Portability" 23 | }, 24 | { 25 | "file": "lib/some_script.pl", 26 | "content": "\n\n=head1 NAME\n\nMoose - moose script" 27 | }, 28 | { 29 | "file": "SIGNATURE", 30 | "content": "A Module::Signature file\n\nBEGIN\n\nAWELRKJ#RL#@JR@WEIFJDSfj9e0jfei\n=notpod\n\nEND\n" 31 | }] 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/prefer-meta-json.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Prefer-Meta-JSON", 3 | "abstract": "A dist with META.yml and META.json", 4 | "version": 1.1, 5 | "X_Module_Faker": { 6 | "cpan_author": "LOCAL", 7 | "omitted_files": ["META.json"], 8 | "append": [ { 9 | "file": "lib/Prefer/Meta/JSON.pm", 10 | "content": "package Prefer::Meta::JSON;\n\n=head1 NAME\n\nPrefer::Meta::JSON - abstract\n\n=cut\n\npackage Prefer::Meta::JSON::Gremlin;\n" 11 | }, 12 | { 13 | "file": "META.json", 14 | "content": "{\"no_index\":{\"package\":[\"Prefer::Meta::JSON::Gremlin\"]},\"meta-spec\":{\"version\":2,\"url\":\"http://search.cpan.org/perldoc?CPAN::Meta::Spec\"},\"generated_by\":\"hand\",\"version\":1.1,\"name\":\"Prefer-Meta-JSON\",\"dynamic_config\":0,\"author\":\"LOCAL\",\"license\":\"unknown\",\"abstract\":\"A dist with META.yml and META.json\",\"release_status\":\"stable\"}" 15 | }, 16 | { 17 | "file": "t/foo.t", 18 | "content": "use Test::More;" 19 | } ] 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/multiple-modules-0.1.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Multiple-Modules", 3 | "abstract": "A dist that provides multiple modules", 4 | "version": "0.1", 5 | "x_provides_comment": "Empty provides: so that Module::Faker won't generate it and we can parse our own.", 6 | "provides": {}, 7 | "X_Module_Faker": { 8 | "cpan_author": "LOCAL", 9 | "mtime": 1380808871, 10 | "append": [ { 11 | "file": "lib/Multiple/Modules.pm", 12 | "content": "package Multiple::Modules;\n\n=head1 NAME\n\nMultiple::Modules - abstract" 13 | }, 14 | { 15 | "file": "lib/Multiple/Modules/Deprecated.pm", 16 | "content": "package Multiple::Modules::Deprecated;\n\n=head1 NAME\n\nMultiple::Modules::Deprecated - Will be removed in a future release\n" 17 | }, 18 | { 19 | "file": "lib/Moose.pm", 20 | "content": "package Moose;\n\n=head1 NAME\n\nMoose - Unauthorized\n" 21 | }, 22 | { 23 | "file": "t/foo.t", 24 | "content": "use Test::More;" 25 | } ] 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | } -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/versions.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Versions", 3 | "abstract": "Modules with different ways to specify versions", 4 | "version": "1.01", 5 | "x_provides_comment": "We specify 'provides' here so that CPAN::Faker will list this dist in 02packages so that metacpan will mark the release as latest. We omit the META files below so that our indexer will parse the pm files rather than trusting the META.", 6 | "provides": { 7 | "Versions": { 8 | "file": "lib/Versions.pm", 9 | "version": 1 10 | } 11 | }, 12 | "X_Module_Faker": { 13 | "cpan_author": "RWSTAUNER", 14 | "omitted_files": ["META.json", "META.yml"], 15 | "append": [ { 16 | "file": "lib/Versions/PkgVar.pm", 17 | "content": "package Versions::PkgVar;\n{ $Versions::PkgVar::VERSION = 1.23; }\n1;" 18 | },{ 19 | "file": "lib/Versions/Our.pm", 20 | "content": "package Versions::Our;\nour $VERSION = 1.45;\n1;" 21 | },{ 22 | "file": "lib/Versions/PkgNameVersion.pm", 23 | "content": "package Versions::PkgNameVersion 1.67;\n1;" 24 | },{ 25 | "file": "lib/Versions/PkgNameVersionBlock.pm", 26 | "content": "package Versions::PkgNameVersionBlock 1.89 {\nuse 5;\n}\n1;" 27 | }] 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/ipsonar-0.29.yml: -------------------------------------------------------------------------------- 1 | name: IPsonar 2 | version: "" 3 | provides: 4 | IPsonar: 5 | file: lib/IPsonar 6 | version: ~ 7 | 8 | X_Module_Faker: 9 | # Version in archive basename but explicitly "" in META. 10 | archive_basename: IPsonar-0.29 11 | 12 | # Archive::Any::Create (used by Module::Faker) doesn't recognize tgz. 13 | #archive_ext: tgz 14 | 15 | omitted_files: 16 | - META.json 17 | - META.yml 18 | 19 | append: 20 | - 21 | file: lib/IPsonar.pm 22 | # Module has version like dist name. 23 | content: | 24 | package IPsonar; 25 | our $VERSION; 26 | $VERSION = "0.29"; 27 | 28 | - 29 | file: META.yml 30 | content: | 31 | --- 32 | abstract: 'a great new dist' 33 | author: 34 | - 'LOCAL ' 35 | dynamic_config: 0 36 | license: perl 37 | meta-spec: 38 | url: http://module-build.sourceforge.net/META-spec-v1.4.html 39 | version: '1.4' 40 | name: IPsonar 41 | version: '' 42 | -------------------------------------------------------------------------------- /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/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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /.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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /.github/workflows/update-snapshot.yml: -------------------------------------------------------------------------------- 1 | name: Update cpanfile.snapshot 2 | on: 3 | schedule: 4 | - cron: "1 15 * * 0" 5 | workflow_dispatch: 6 | jobs: 7 | update-dep: 8 | runs-on: "ubuntu-22.04" 9 | container: 10 | image: perl:5.22-buster 11 | steps: 12 | - name: Generate Auth Token 13 | uses: actions/create-github-app-token@v2 14 | id: app-token 15 | with: 16 | app-id: ${{ secrets.APP_ID }} 17 | private-key: ${{ secrets.APP_PRIVATE_KEY }} 18 | - uses: haarg/setup-git-user@v1 19 | with: 20 | app: ${{ steps.app-token.output.app-slug }} 21 | - uses: actions/checkout@v6 22 | with: 23 | token: ${{ steps.app-token.outputs.token }} 24 | - name: Update cpanfile.snapshot 25 | uses: metacpan/metacpan-actions/update-snapshot@master 26 | - name: Create Pull Request 27 | uses: peter-evans/create-pull-request@v8 28 | with: 29 | token: ${{ steps.app-token.outputs.token }} 30 | commit-message: Update cpanfile.snapshot 31 | title: Update cpanfile.snapshot 32 | sign-commits: true 33 | body: | 34 | [GitHub Action Run](${{ github.server_url }}/${{ github.repository }}/actions/runs/${{ github.run_id }}) 35 | branch: update-cpanfile-snapshot 36 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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( refaddr weaken ); 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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /xt/search_web.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | # USE `bin/prove_live` to run this 6 | # READ the README.txt in this dir 7 | 8 | use MetaCPAN::Query::Search (); 9 | use MetaCPAN::TestServer (); 10 | use Test::More; 11 | 12 | # Just use this to get an es object. 13 | my $server = MetaCPAN::TestServer->new; 14 | my $search = MetaCPAN::Query::Search->new( es => $server->es_client ); 15 | 16 | my %tests = ( 17 | 'anyevent http' => 'AnyEvent::HTTP', 18 | 'anyevent' => 'AnyEvent', 19 | 'AnyEvent' => 'AnyEvent', 20 | 'dbi' => 'DBI', 21 | 'dbix class resultset' => 'DBIx::Class::ResultSet', 22 | 'DBIx::Class' => 'DBIx::Class', 23 | 'Dist::Zilla' => 'Dist::Zilla', 24 | 'HTML::Element' => 'HTML::Element', 25 | 'HTML::TokeParser' => 'HTML::TokeParser', 26 | 'net dns' => 'Net::DNS', 27 | 'net::amazon::s3' => 'Net::Amazon::S3', 28 | 'Perl::Critic' => 'Perl::Critic', 29 | ); 30 | 31 | for my $q ( sort keys %tests ) { 32 | my $match = $tests{$q}; 33 | my $returned = $search->search_web($q); 34 | my $first_match = $returned->{results}->[0]->[0]; 35 | 36 | is( $first_match->{documentation}, 37 | $match, "Search for ${q} matched ${match}" ); 38 | 39 | # or diag Dumper($first_match); 40 | } 41 | 42 | done_testing(); 43 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/multiple-modules-1.01.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "Multiple-Modules", 3 | "version": 1.01, 4 | "X_Module_Faker": { 5 | "cpan_author": "LOCAL", 6 | "mtime": 1381808871, 7 | "omitted_files": ["META.json"], 8 | "append": [ { 9 | "file": "lib/Multiple/Modules.pm", 10 | "content": "package Multiple::Modules;\n\n=head1 NAME\n\nMultiple::Modules - abstract" 11 | }, 12 | { 13 | "file": "lib/Multiple/Modules/A.pm", 14 | "content": "package Multiple::Modules::A;\n\n=head1 NAME\n\nMultiple::Modules::A - MMA\n\n=cut\n\npackage Multiple::Modules::A2;\n" 15 | }, 16 | { 17 | "file": "lib/Multiple/Modules/B.pm", 18 | "content": "package Multiple::Modules::B;\n\n=head1 NAME\n\nMultiple::Modules::B - MMB\n\n=cut\n\npackage\nMultiple::Modules::_B2;# hidden from pause\n\npackage Multiple::Modules::B::Secret; # meta no_index\n" 19 | }, 20 | { 21 | "file": "META.json", 22 | "content": "{\"no_index\":{\"package\":[\"Multiple::Modules::B::Secret\"]},\"meta-spec\":{\"version\":2,\"url\":\"http://search.cpan.org/perldoc?CPAN::Meta::Spec\"},\"generated_by\":\"hand\",\"version\":1.01,\"name\":\"Multiple-Modules\",\"dynamic_config\":0,\"author\":\"LOCAL\",\"license\":\"unknown\",\"release_status\":\"stable\"}" 23 | }, 24 | { 25 | "file": "t/foo.t", 26 | "content": "use Test::More;" 27 | } ] 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /precious.toml: -------------------------------------------------------------------------------- 1 | exclude = [ 2 | "/.build/**", 3 | "/blib/**", 4 | "/root/assets/**", 5 | "/local/**", 6 | "/test-data/**", 7 | ] 8 | 9 | [commands.perlimports] 10 | type = "both" 11 | include = [ "**/*.{pl,pm,t,psgi}", "bin/metacpan" ] 12 | cmd = [ "perlimports" ] 13 | lint-flags = ["--lint" ] 14 | tidy-flags = ["-i" ] 15 | ok-exit-codes = 0 16 | expect-stderr = true 17 | 18 | [commands.perlcritic] 19 | type = "lint" 20 | include = [ "**/*.{pl,pm,t,psgi}", "bin/metacpan" ] 21 | cmd = [ "perlcritic", "--profile=$PRECIOUS_ROOT/.perlcriticrc" ] 22 | ok-exit-codes = 0 23 | lint-failure-exit-codes = 2 24 | 25 | [commands.perltidy] 26 | type = "both" 27 | include = [ "**/*.{pl,pm,t,psgi}", "bin/metacpan" ] 28 | cmd = [ "perltidy", "--profile=$PRECIOUS_ROOT/.perltidyrc" ] 29 | lint-flags = [ "--assert-tidy", "--no-standard-output", "--outfile=/dev/null" ] 30 | tidy-flags = [ "--backup-and-modify-in-place", "--backup-file-extension=/" ] 31 | ok-exit-codes = 0 32 | lint-failure-exit-codes = 2 33 | ignore-stderr = "Begin Error Output Stream" 34 | label = ["perltidy"] 35 | 36 | [commands.omegasort-gitignore] 37 | type = "both" 38 | include = "**/.gitignore" 39 | cmd = [ "omegasort", "--sort", "path", "--unique" ] 40 | lint-flags = "--check" 41 | tidy-flags = "--in-place" 42 | ok-exit-codes = 0 43 | lint-failure-exit-codes = 1 44 | ignore-stderr = [ 45 | "The .+ file is not sorted", 46 | "The .+ file is not unique", 47 | ] 48 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | --- 2 | # Use the latest 2.1 version of CircleCI pipeline process engine. See: 3 | # https://circleci.com/docs/2.0/configuration-reference 4 | version: 2.1 5 | orbs: 6 | codecov: codecov/codecov@4.1.0 7 | # Orchestrate or schedule a set of jobs 8 | workflows: 9 | docker-compose: 10 | jobs: 11 | - build-and-test 12 | jobs: 13 | build-and-test: 14 | machine: true 15 | resource_class: large 16 | steps: 17 | - run: 18 | name: docker compose version 19 | command: docker compose version 20 | - checkout 21 | - run: 22 | name: create coverage directory 23 | command: | 24 | mkdir cover_db 25 | chmod o+w cover_db 26 | - run: 27 | name: docker compose build 28 | command: | 29 | docker compose --profile test build api-test 30 | - run: 31 | name: run tests with coverage 32 | command: | 33 | docker compose --profile test run --env HARNESS_PERL_SWITCHES=-MDevel::Cover -v ./cover_db:/app/cover_db/ api-test bash -c 'prove -lr -j4 t && cover -report codecovbash' 34 | # We are relying on environment variables from the host to be available when 35 | # we publish the report, so we publish from the host rather than trying 36 | # to propagate env variables to the container. 37 | - codecov/upload: 38 | file: cover_db/codecov.json 39 | -------------------------------------------------------------------------------- /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 < 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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /.github/workflows/code-formatting.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: Code Formatting 3 | on: 4 | push: 5 | branches: 6 | - 'master' 7 | merge_group: 8 | pull_request: 9 | branches: 10 | - '*' 11 | workflow_dispatch: 12 | 13 | jobs: 14 | code-formatting: 15 | runs-on: ubuntu-24.04 16 | name: Code Formatting 17 | steps: 18 | - uses: actions/checkout@v6 19 | with: 20 | fetch-depth: 0 21 | - name: Fetch base ref 22 | if: ${{ github.event.pull_request }} 23 | run: git fetch origin ${{ github.base_ref }}:upstream 24 | - name: Install Carton 25 | uses: perl-actions/install-with-cpm@v1 26 | with: 27 | install: Carton 28 | - name: Install CPAN deps 29 | uses: perl-actions/install-with-cpm@v1 30 | with: 31 | cpanfile: 'cpanfile' 32 | args: > 33 | --resolver=snapshot 34 | --with-develop 35 | - name: Install precious 36 | run: ./bin/install-precious /usr/local/bin 37 | env: 38 | GITHUB_TOKEN: ${{ github.token }} 39 | - run: perltidy --version 40 | - name: Select files 41 | id: select-files 42 | run: | 43 | if [[ -n "${{ github.event.pull_request.number }}" ]]; then 44 | echo 'precious-args=--git-diff-from upstream' >> "$GITHUB_OUTPUT" 45 | else 46 | echo 'precious-args=--all' >> "$GITHUB_OUTPUT" 47 | fi 48 | - name: Lint files 49 | run: precious lint ${{ steps.select-files.outputs.precious-args }} 50 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /wait-for-es.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Courtesy of @fxdgear 4 | # https://github.com/elastic/elasticsearch-py/issues/778#issuecomment-384389668 5 | 6 | set -ux 7 | 8 | 9 | HOST="$1" 10 | CONTAINER=${2:-""} 11 | PREAMBLE="" 12 | 13 | echo "container |$CONTAINER|" 14 | if [[ $CONTAINER != "" ]]; then 15 | PREAMBLE="docker-compose exec $CONTAINER" 16 | fi 17 | 18 | while true; do 19 | response=$($PREAMBLE curl --write-out '%{http_code}' --silent --fail --output /dev/null "$HOST") 20 | if [[ "$response" -eq "200" ]]; then 21 | break 22 | fi 23 | 24 | echo "Elastic Search is unavailable - sleeping" >&2 25 | sleep 1 26 | done 27 | 28 | # set -e now because it was causing the curl command above to exit the script 29 | # if the server was not available 30 | set -e 31 | 32 | COUNTER=0 33 | MAX_LOOPS=60 34 | while true; do 35 | ## Wait for ES status to turn to yellow. 36 | ## TODO: Ideally we'd be waiting for green, but we need multiple nodes for that. 37 | health=$($PREAMBLE curl -fsSL "$HOST/_cat/health?format=JSON" | jq '.[0].status == "yellow" or .[0].status == "green"') 38 | if [[ $health == 'true' ]]; then 39 | echo "Elasticsearch is up" >&2 40 | break 41 | fi 42 | echo "Elastic Search is unavailable ($health) - sleeping" >&2 43 | COUNTER=$((COUNTER + 1)) 44 | if [[ $COUNTER -gt $MAX_LOOPS ]]; then 45 | echo "Giving up after $COUNTER attempts" 46 | exit 1 47 | break 48 | fi 49 | sleep 1 50 | done 51 | 52 | # Allow commands to be chained 53 | shift 54 | shift 55 | exec "$@" 56 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /test-data/fakecpan/configs/binary-data.pl: -------------------------------------------------------------------------------- 1 | ## no critic 2 | { 3 | name => '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' => < } 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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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 | -------------------------------------------------------------------------------- /.github/workflows/build-container.yml: -------------------------------------------------------------------------------- 1 | name: Build container 2 | on: 3 | push: 4 | branches: 5 | - master 6 | - staging 7 | - prod 8 | pull_request: 9 | types: [opened, synchronize, labeled] 10 | branches: 11 | - master 12 | workflow_dispatch: 13 | jobs: 14 | docker-build: 15 | if: github.event_name != 'pull_request' || contains(github.event.pull_request.labels.*.name, 'build-container') 16 | runs-on: ubuntu-22.04 17 | name: Docker Build and Push 18 | steps: 19 | - name: Generate Auth Token 20 | uses: actions/create-github-app-token@v2 21 | id: app-token 22 | with: 23 | app-id: ${{ secrets.APP_ID }} 24 | private-key: ${{ secrets.APP_PRIVATE_KEY }} 25 | owner: metacpan 26 | - uses: actions/checkout@v6 27 | with: 28 | token: ${{ steps.app-token.outputs.token }} 29 | - uses: metacpan/metacpan-actions/docker-build-push@master 30 | id: build-push 31 | with: 32 | docker_hub_username: ${{ secrets.DOCKER_HUB_USER }} 33 | docker_hub_password: ${{ secrets.DOCKER_HUB_TOKEN }} 34 | ghcr_username: ${{ github.repository_owner }} 35 | ghcr_password: ${{ secrets.GITHUB_TOKEN }} 36 | - name: Update deployed image 37 | if: ${{ fromJSON(steps.build-push.outputs.tag-fq).latest }} 38 | uses: metacpan/metacpan-actions/update-deployed-tag@master 39 | with: 40 | token: ${{ steps.app-token.outputs.token }} 41 | app: api 42 | environment: prod 43 | base-tag: ${{ fromJSON(steps.build-push.outputs.tag-fq).latest }} 44 | tag: ${{ fromJSON(steps.build-push.outputs.tag-fq).sha }} 45 | -------------------------------------------------------------------------------- /docker-compose.yml: -------------------------------------------------------------------------------- 1 | services: 2 | api-server: 3 | build: 4 | context: . 5 | target: develop 6 | volumes: 7 | - './:/app/' 8 | - '/app/local' 9 | ports: 10 | - '8001:8000' 11 | environment: 12 | # default is 120, shorten to work with compose label 13 | COLUMNS: 96 14 | develop: 15 | watch: 16 | - path: ./cpanfile 17 | action: rebuild 18 | 19 | api-test: 20 | profiles: 21 | - test 22 | depends_on: 23 | elasticsearch-test: 24 | condition: service_healthy 25 | build: 26 | context: . 27 | target: test 28 | environment: 29 | NET_ASYNC_HTTP_MAXCONNS: 1 30 | COLUMNS: 80 31 | ES: http://elasticsearch-test:9200 32 | HARNESS_ACTIVE: 1 33 | # Instantiate Catalyst models using metacpan_server_testing.conf 34 | METACPAN_SERVER_CONFIG_LOCAL_SUFFIX: testing 35 | MINICPAN: /CPAN 36 | DEVEL_COVER_OPTIONS: +ignore,^t/|^test-data/|^etc/|^local/ 37 | networks: 38 | - elasticsearch 39 | volumes: 40 | - type: volume 41 | source: elasticsearch-test 42 | target: /usr/share/elasticsearch/data 43 | 44 | elasticsearch-test: 45 | profiles: 46 | - test 47 | platform: linux/amd64 48 | image: elasticsearch:2.4 49 | environment: 50 | - discovery.type=single-node 51 | healthcheck: 52 | timeout: 5s 53 | start_period: 60s 54 | test: ["CMD", "curl", "--fail", "http://localhost:9200/_cluster/health?wait_for_status=yellow&timeout=5s"] 55 | ports: 56 | - "9200" 57 | networks: 58 | - elasticsearch 59 | 60 | networks: 61 | elasticsearch: 62 | 63 | volumes: 64 | elasticsearch-test: 65 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /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/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/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 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/Login/GitHub.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::Login::GitHub; 2 | 3 | use Moose; 4 | 5 | use Cpanel::JSON::XS qw( decode_json ); 6 | use HTTP::Request::Common qw( GET POST ); 7 | use LWP::UserAgent (); 8 | 9 | BEGIN { extends 'MetaCPAN::Server::Controller::Login' } 10 | 11 | has [qw(consumer_key consumer_secret)] => ( 12 | is => 'ro', 13 | required => 1, 14 | ); 15 | 16 | sub index : Path Args(0) { 17 | my ( $self, $c ) = @_; 18 | if ( my $code = $c->req->params->{code} ) { 19 | my $ua = LWP::UserAgent->new; 20 | my $res = $ua->request( 21 | POST 'https://github.com/login/oauth/access_token', 22 | [ 23 | client_id => $self->consumer_key, 24 | redirect_uri => $c->uri_for( $self->action_for('index') ), 25 | client_secret => $self->consumer_secret, 26 | code => $code, 27 | ] 28 | ); 29 | $c->controller('OAuth2')->redirect( $c, error => $1 ) 30 | if ( $res->content =~ /^error=(.*)$/ ); 31 | ( my $token = $res->content ) =~ s/^access_token=//; 32 | $c->controller('OAuth2')->redirect( $c, error => 'token' ) 33 | unless ($token); 34 | $token =~ s/&.*$//; 35 | my $extra_res = $ua->request( 36 | GET 'https://api.github.com/user', 37 | authorization => "token $token" 38 | ); 39 | my $extra = eval { decode_json( $extra_res->content ) } || {}; 40 | $self->update_user( $c, github => $extra->{id}, $extra ); 41 | } 42 | else { 43 | $c->res->redirect( 44 | 'https://github.com/login/oauth/authorize?client_id=' 45 | . $self->consumer_key ); 46 | } 47 | } 48 | 49 | 1; 50 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Query/Mirror.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Query::Mirror; 2 | 3 | use MetaCPAN::Moose; 4 | use MetaCPAN::Util qw( hit_total ); 5 | 6 | use MetaCPAN::ESConfig qw( es_doc_path ); 7 | 8 | with 'MetaCPAN::Query::Role::Common'; 9 | 10 | sub search { 11 | my ( $self, $q ) = @_; 12 | my $query = { match_all => {} }; 13 | 14 | if ($q) { 15 | my @protocols = grep /^ (?: http | ftp | rsync ) $/x, split /\s+/, $q; 16 | 17 | $query = { 18 | bool => { 19 | must => [ map +{ exists => { field => $_ } }, @protocols ] 20 | }, 21 | }; 22 | } 23 | 24 | my @sort = ( sort => [qw( continent country )] ); 25 | 26 | my $location; 27 | 28 | if ( $q and $q =~ /loc\:([^\s]+)/ ) { 29 | $location = [ split( /,/, $1 ) ]; 30 | if ($location) { 31 | @sort = ( 32 | sort => { 33 | _geo_distance => { 34 | location => [ $location->[1], $location->[0] ], 35 | order => 'asc', 36 | unit => 'km' 37 | } 38 | } 39 | ); 40 | } 41 | } 42 | 43 | my $ret = $self->es->search( 44 | es_doc_path('mirror'), 45 | body => { 46 | size => 999, 47 | query => $query, 48 | @sort, 49 | }, 50 | ); 51 | 52 | my $data = [ 53 | map +{ 54 | %{ $_->{_source} }, 55 | distance => ( $location ? $_->{sort}[0] : undef ) 56 | }, 57 | @{ $ret->{hits}{hits} } 58 | ]; 59 | 60 | return { 61 | mirrors => $data, 62 | total => hit_total($ret), 63 | took => $ret->{took} 64 | }; 65 | } 66 | 67 | __PACKAGE__->meta->make_immutable; 68 | 1; 69 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Server/Controller/User/Favorite.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Server::Controller::User::Favorite; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Moose; 7 | use MetaCPAN::Util qw( true false ); 8 | 9 | BEGIN { extends 'Catalyst::Controller::REST' } 10 | 11 | sub index : Path : ActionClass('REST') { 12 | } 13 | 14 | sub index_POST { 15 | my ( $self, $c ) = @_; 16 | my $pause = $c->stash->{pause}; 17 | my $data = $c->req->data; 18 | my $favorite = $c->model('ESModel')->doc('favorite')->put( 19 | { 20 | user => $c->user->id, 21 | author => $data->{author}, 22 | release => $data->{release}, 23 | distribution => $data->{distribution}, 24 | }, 25 | { refresh => true } 26 | ); 27 | $c->purge_author_key( $data->{author} ) if $data->{author}; 28 | $c->purge_dist_key( $data->{distribution} ) if $data->{distribution}; 29 | $self->status_created( 30 | $c, 31 | location => $c->uri_for( join( '/', 32 | '/favorite', $favorite->user, $favorite->distribution ) ), 33 | entity => $favorite->meta->get_data($favorite) 34 | ); 35 | } 36 | 37 | sub index_DELETE { 38 | my ( $self, $c, $distribution ) = @_; 39 | my $favorite = $c->model('ESModel')->doc('favorite') 40 | ->get( { user => $c->user->id, distribution => $distribution } ); 41 | if ($favorite) { 42 | $favorite->delete( { refresh => true } ); 43 | $c->purge_author_key( $favorite->author ) 44 | if $favorite->author; 45 | $c->purge_dist_key($distribution); 46 | $self->status_ok( $c, 47 | entity => $favorite->meta->get_data($favorite) ); 48 | } 49 | else { 50 | $self->status_not_found( $c, message => 'Entity could not be found' ); 51 | } 52 | } 53 | 54 | 1; 55 | -------------------------------------------------------------------------------- /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 | use Data::Visitor::Callback (); 9 | 10 | sub config { 11 | my $root = root_dir(); 12 | my $config = _zomg($root); 13 | 14 | if ( !$config ) { 15 | die "Couldn't find config file in $root"; 16 | } 17 | 18 | return $config; 19 | } 20 | 21 | sub _zomg { 22 | my $path = shift; 23 | 24 | my $config = Config::ZOMG->new( 25 | name => 'metacpan_server' 26 | . ( $ENV{HARNESS_ACTIVE} ? '_testing' : '' ), 27 | path => $path, 28 | ); 29 | 30 | my $c = $config->open; 31 | if ( defined $c->{logger} && ref $c->{logger} ne 'ARRAY' ) { 32 | $c->{logger} = [ $c->{logger} ]; 33 | } 34 | 35 | my $root = root_dir(); 36 | my $v = Data::Visitor::Callback->new( 37 | plain_value => sub { 38 | return unless defined $_; 39 | s{ 40 | (__HOME__) 41 | | 42 | (\$\{([^\}]+)\}) 43 | }{ 44 | defined $1 ? $root 45 | : defined $2 ? do { 46 | my $var = $3; 47 | if ($var =~ s{:-(.*)}{}) { 48 | my $sub = $1; 49 | $ENV{$var} // $1; 50 | } 51 | elsif ($var =~ s{:\+(.*)}{}) { 52 | my $sub = $1; 53 | $ENV{$var} ? $sub : ''; 54 | } 55 | else { 56 | $ENV{$var} // ''; 57 | } 58 | } 59 | : '' 60 | }gex; 61 | } 62 | ); 63 | $v->visit($c); 64 | 65 | return keys %{$c} ? $c : undef; 66 | } 67 | 68 | 1; 69 | -------------------------------------------------------------------------------- /lib/MetaCPAN/Query/Contributor.pm: -------------------------------------------------------------------------------- 1 | package MetaCPAN::Query::Contributor; 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_contributors { 11 | my ( $self, $author, $name ) = @_; 12 | 13 | my $query = +{ 14 | bool => { 15 | must => [ 16 | { term => { release_author => $author } }, 17 | { term => { release_name => $name } }, 18 | { exists => { field => 'pauseid' } }, 19 | ] 20 | } 21 | }; 22 | 23 | my $res = $self->es->search( 24 | es_doc_path('contributor'), 25 | body => { 26 | query => $query, 27 | size => 999, 28 | _source => [ qw( 29 | distribution 30 | pauseid 31 | release_author 32 | release_name 33 | ) ], 34 | } 35 | ); 36 | hit_total($res) or return {}; 37 | 38 | return +{ 39 | contributors => [ map { $_->{_source} } @{ $res->{hits}{hits} } ] }; 40 | } 41 | 42 | sub find_author_contributions { 43 | my ( $self, $pauseid ) = @_; 44 | 45 | my $query = +{ term => { pauseid => $pauseid } }; 46 | 47 | my $res = $self->es->search( 48 | es_doc_path('contributor'), 49 | body => { 50 | query => $query, 51 | size => 999, 52 | _source => [ qw( 53 | distribution 54 | pauseid 55 | release_author 56 | release_name 57 | ) ], 58 | } 59 | ); 60 | hit_total($res) or return {}; 61 | 62 | return +{ 63 | contributors => [ map { $_->{_source} } @{ $res->{hits}{hits} } ] }; 64 | } 65 | 66 | __PACKAGE__->meta->make_immutable; 67 | 1; 68 | -------------------------------------------------------------------------------- /lib/ElasticSearchX/Model/Document/Set.pm: -------------------------------------------------------------------------------- 1 | package ElasticSearchX::Model::Document::Set; 2 | use strict; 3 | use warnings; 4 | 5 | use MetaCPAN::Model::Hacks; 6 | 7 | no warnings 'redefine'; 8 | 9 | our %query_override; 10 | my $_build_query = \&_build_query; 11 | *_build_query = sub { 12 | my $query = $_build_query->(@_); 13 | %$query = ( %$query, %query_override ); 14 | return $query; 15 | }; 16 | 17 | our %qs_override; 18 | my $_build_qs = \&_build_qs; 19 | *_build_qs = sub { 20 | my $qs = $_build_qs->(@_); 21 | %$qs = ( %$qs, %qs_override ); 22 | return $qs; 23 | }; 24 | 25 | # ESXM normally tries to use search_type => scan, which is deprecated or 26 | # removed in newer Elasticsearch versions. Sorting on _doc gives the same 27 | # optimization. 28 | my $delete = \&delete; 29 | *delete = sub { 30 | local %qs_override = ( search_type => 'query_then_fetch' ); 31 | local %query_override = ( sort => '_doc' ); 32 | return $delete->(@_); 33 | }; 34 | 35 | my $get = \&get; 36 | *get = sub { 37 | my ( $self, $args, $qs ) = @_; 38 | if ( $self->es->api_version eq '2_0' ) { 39 | goto &$get; 40 | } 41 | my %qs = %{ $qs || {} }; 42 | if ( my $fields = $self->fields ) { 43 | $qs{_source} = $fields; 44 | local $self->{fields}; 45 | return $get->( $self, $args, \%qs ); 46 | } 47 | goto &$get; 48 | }; 49 | 50 | # ESXM will try to inflate based on the index/type stored in the result. We 51 | # are using aliases, and ESXM doesn't know about the actual index that the 52 | # docs are stored in. Instead, allow it to use the configured index/type for 53 | # this doc set. 54 | my $inflate_result = \&inflate_result; 55 | *inflate_result = sub { 56 | my ( $self, $res ) = @_; 57 | my $new_res = {%$res}; 58 | delete $new_res->{_index}; 59 | delete $new_res->{_type}; 60 | $self->$inflate_result($new_res); 61 | }; 62 | 63 | 1; 64 | -------------------------------------------------------------------------------- /t/script/runner.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 't/lib'; 4 | 5 | use MetaCPAN::Script::Runner (); 6 | use Module::Pluggable search_dirs => ['t/lib']; 7 | use Test::More; 8 | 9 | subtest 'runner succeeds' => sub { 10 | local @ARGV = ('mockerror'); 11 | 12 | ok( MetaCPAN::Script::Runner::run, 'succeeds' ); 13 | 14 | is( $MetaCPAN::Script::Runner::EXIT_CODE, 0, "Exit Code '0' - No Error" ); 15 | }; 16 | 17 | subtest 'runner fails' => sub { 18 | local @ARGV 19 | = ( 'mockerror', '--error', 11, '--message', 'mock error message' ); 20 | 21 | ok( !MetaCPAN::Script::Runner::run, 'fails as expected' ); 22 | 23 | is( $MetaCPAN::Script::Runner::EXIT_CODE, 24 | 11, "Exit Code '11' as expected" ); 25 | }; 26 | 27 | # Disable for the time being. There is a better way to check exit codes. 28 | # 29 | # subtest 'runner dies' => sub { 30 | # local @ARGV = ( 'mockerror', '--die', '--message', 'mock die message' ); 31 | # 32 | # ok( !MetaCPAN::Script::Runner::run, 'fails as expected' ); 33 | # 34 | # is( $MetaCPAN::Script::Runner::EXIT_CODE, 1, 35 | # "Exit Code '1' as expected" ); 36 | # }; 37 | 38 | subtest 'runner exits with error' => sub { 39 | local @ARGV = ( 40 | 'mockerror', '--handle_error', '--error', 17, '--message', 41 | 'mock handled error message' 42 | ); 43 | 44 | ok( !MetaCPAN::Script::Runner::run, 'fails as expected' ); 45 | 46 | is( $MetaCPAN::Script::Runner::EXIT_CODE, 47 | 17, "Exit Code '17' as expected" ); 48 | }; 49 | 50 | subtest 'runner throws exception' => sub { 51 | local @ARGV = ( 52 | 'mockerror', '--exception', '--error', 19, '--message', 53 | 'mock exception message' 54 | ); 55 | 56 | ok( !MetaCPAN::Script::Runner::run, 'fails as expected' ); 57 | 58 | is( $MetaCPAN::Script::Runner::EXIT_CODE, 59 | 19, "Exit Code '19' as expected" ); 60 | }; 61 | 62 | done_testing(); 63 | --------------------------------------------------------------------------------