CPAN-Mini-Inject-1.012/0000755000076500000240000000000014773404623013332 5ustar brianstaffCPAN-Mini-Inject-1.012/bin/0000755000076500000240000000000014773404622014101 5ustar brianstaffCPAN-Mini-Inject-1.012/bin/mcpani0000644000076500000240000001574014773404621015301 0ustar brianstaff#!/usr/bin/perl use v5.16; use strict; use Pod::Usage 1.12; use Getopt::Long; use YAML qw( Load ); use CPAN::Mini::Inject; use Env; use File::Slurp 'write_file'; use File::Temp; our $VERSION = '0.38'; our %options = (); sub print_version { printf( "mcpani v%s, using CPAN::Mini::Inject v%s and Perl v%vd\n", $VERSION, $CPAN::Mini::Inject::VERSION, $^V ); } sub chkactions { for my $action ( qw(add update mirror inject) ) { return 1 if ( $options{actionname} eq $action ); } return 0; } sub setsub { $options{actionname} = shift; $options{action} = shift; } sub add { my $mcpi = shift; $mcpi->readlist; $mcpi->add( module => $options{module}, authorid => $options{authorid}, version => $options{version}, file => $options{file} ); if ( $options{verbose} ) { my @added = $mcpi->added_modules; foreach my $added ( @added ){ print "\nAdding File: $added->{file}\n"; print "Author ID: $added->{authorid}\n"; my $modules = $added->{modules}; foreach my $mod ( sort keys %$modules ){ print "Module: $mod\n"; print "Version: $modules->{$mod}\n"; } print "To repository: $mcpi->{config}{repository}\n\n"; } } $mcpi->writelist; } sub update { my $mcpi = shift; mirror( $mcpi ); inject( $mcpi ); } sub mirror { my $mcpi = shift; # these come from the command line my %mirroropts = map { $_ => $options{$_} } grep { defined $options{$_} } qw(remote local verbose); $mcpi->update_mirror( %mirroropts ); } sub inject { my $mcpi = shift; print "Injecting modules from $mcpi->{config}{repository}\n" if ( $options{verbose} ); $mcpi->inject( $options{verbose} ); } # MAIN Getopt::Long::Configure( 'no_ignore_case' ); Getopt::Long::Configure( 'bundling' ); GetOptions( 'h|help|?' => sub { pod2usage( { -verbose => 1, -input => \*DATA } ); exit }, 'H|man' => sub { pod2usage( { -verbose => 2, -input => \*DATA } ); exit }, 'V|version' => sub { print_version(); exit; }, 'v|verbose' => \$options{verbose}, 'l|local=s' => \$options{local}, 'r|remote=s' => \$options{remote}, 'p|passive' => \$ENV{FTP_PASSIVE}, 'add' => sub { setsub( 'add', \&add ) }, 'update' => sub { setsub( 'update', \&update ) }, 'mirror' => sub { setsub( 'mirror', \&mirror ) }, 'inject' => sub { setsub( 'inject', \&inject ) }, 'module=s' => \$options{module}, 'authorid=s' => \$options{authorid}, 'modversion=s' => \$options{version}, 'file=s' => \$options{file}, 'all-in-meta' => \$options{'all-in-meta'}, 'signing-key=s' => \$options{'signing_key'}, 'discover-packages' => \$options{'discover-packages'}, ) or exit 1; unless ( defined( $options{action} ) && chkactions() ) { pod2usage( { -verbose => 1, -input => \*DATA } ); exit; } my $mcpi = CPAN::Mini::Inject->new->loadcfg( $options{cfg} )->parsecfg; $CPAN::Checksums::SIGNING_KEY = $options{'signing_key'} if ($options{'signing_key'}); &{ $options{action} }( $mcpi ); __END__ =head1 NAME mcpani -- A command line tool to manage a CPAN Mini Mirror. =head1 SYNOPSIS mcpani [options] < --add | --update | --mirror | --inject > Commands: --add Add a new package to the repository --module Name of the module to add --authorid Author ID of the module --modversion Version number of the module --file distribution module --update Update local CPAN mirror and inject modules --mirror Update local CPAN mirror from remote --inject Add modules from repository to CPAN mirror Options: -h, --help This synopsis -H, --man Detailed description -l, --local local location for CPAN::Mini Mirror -r, --remote CPAN mirror to mirror from -p, --passive Enable passive ftp for mirroring. -v, --verbose verbose output -V, --version Version information. --signing-key See CPAN::Checksums $SIGNING_KEY =head1 DESCRIPTION B uses L to build or update a local CPAN mirror from a remote one, while also adding private or third-party distributions. =head2 Configuration file B will search the following four places in order: =over 4 =item * file pointed to by the environment variable MCPANI_CONFIG =item * $HOME/.mcpani/config =item * /usr/local/etc/mcpani =item * /etc/mcpani =back By default, B uses a simple configuration file in the following format: local: /www/CPAN remote: ftp://ftp.cpan.org/pub/CPAN ftp://ftp.kernel.org/pub/CPAN repository: /work/mymodules passive: yes dirmode: 0755 =head2 Configuration options =over 4 =item C Set the permissions of created directories to the specified mode (octal value). The default value is based on the umask (if supported). =item C Update modules even if the module list is out of data. This is from L. =item C (required) Location to store local CPAN::Mini mirror =item C The logging level for L. =item C Enable passive FTP. =item C (required) CPAN site(s) to mirror from. Multiple sites can be listed, with spaces between them. =item C Location to store modules to add to the local CPAN::Mini mirror. =item C Do not remove old files in the local directory. this is from L. =item C Do not mirror B distributions. This is from L. =item C Enable trace logging. This is from L =back =head2 Command-line options =over 4 =item C<--add> =over 4 =item C<--authorid> the CPAN ID =item C<--file> the distribution file =item C<--module> the package name of the main module =item C<-v>, C<--verbose> =item C<--version> the version of the distribution =back =item C<-h>, C<-H>, C<--help>, C<--man>, C<-?> Output a help message and exit. =item C<--inject> Inject the local distributions into the local repository. =over 4 =item C<-v>, C<--verbose> =back =item C<--mirror> Update the local MiniCPAN by downloading the latest modules from the public CPAN (or the CPAN-like repo specified in the C config. C<--mirror> uses =over 4 =item C<-l>, C<--local> =item C<-r>, C<--remote> =item C<-v>, C<--verbose> =back =item C<--update> This runs C<--mirror> then C<--inject>. =item C<-V>, C<--version> Output the version of B and exit. =back =head1 AUTHOR Shawn Sorichetti C<< >> =head1 SOURCE AVAILABILITY The main repository is on GitHub: https://github.com/briandfoy/cpan-mini-inject There are also backup repositories on several other services: https://bitbucket.org/briandfoy/cpan-mini-inject https://codeberg.org/briandfoy/cpan-mini-inject https://gitlab.com/briandfoy/cpan-mini-inject =head1 COPYRIGHT & LICENSE Copyright 2004 Shawn Sorichetti, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut CPAN-Mini-Inject-1.012/Changes0000644000076500000240000002021514773404621014623 0ustar brianstaffRevision history for CPAN-Mini-Inject 1.012 2025-04-03T04:07:45Z * fix a documentation nit with add() (GitHub #21) 1.011 2025-02-13T02:38:03Z * HTTP::Daemon and Net::EmptyPort are no longer prereqs and are moved to TEST_REQUIRES. If they are not present, those tests that use them will be skipped (#7) * you can now inject into an empty directory. Previously the module would throw an error about a missing 02packages file. Now the module just ignores that missing file and will recreate it. (#9) * document skip_cleanup and several other config values passed through to CPAN::Mini (#16, #17) * write the new 02packages data to a temp file first, then move it into place when it's complete. This keeps parallel processes from trying to edit the same file at the same time (#18) * error messages now include the name of the program and the names of any files involved. If you are testing for certain strings, you should check for the new strings. 1.009_01 2025-02-01T18:02:55Z * create 02packages as a temp file first, then move it into place. This is one of probably many problems with running several mcpani processes at the same time (#18) 1.008 2025-01-17T13:45:32Z * Fix indexing problem while not hiding CPAN::Meta::Convertor correctly. 1.007 2025-01-16T21:09:23Z * pass CPAN::Mini config parameters to CPAN::Mini while calling update (#16) 1.006_001 2025-01-15T18:43:49Z * pass all configuration options to CPAN::Mini->update_mirror (#16) 1.005 2024-09-09T13:18:08Z * temporary fix for CPAN::Meta until upstream is released. See https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues/138 . (#31, from XSven). 1.004_05 2024-09-01T21:53:16Z * try to nail down a couple of CPAN Testers holdouts that seem to have weird setups 1.004_04 2024-08-18T07:16:41Z * if we can't start the remote server for testing, bypass the tests without failing. 1.004_03 2024-07-31T12:57:36Z * some small refactorings and doc improvements 1.004_02 2024-07-30T10:51:40Z * override some of CPAN::Meta::Converter so it doesn't change the version string. This was exposed by an edge case like v1.2.3_4 where the numified and string versions are different. CPAN::Mini::Inject will use the original string version that the distribution declared. (GitHub #11) 1.003 2024-06-10T08:56:12Z * left mcpani out of EXE_FILES (#3) 1.002 2024-06-07T19:31:11Z * promote to a user version 1.001_02 2024-05-29T00:56:52Z * Adjust the test for unreachable hosts when the tester resolves any host 1.001_01 2024-05-26T12:27:59Z * fix bug in t/update_mirror.t that caused weird issues when the test web server went away (AndyA/CPAN--Mini--Inject#26, from Lukas Märdian) * added --skip_cleanup for updating a mirror (AndyA/CPAN--Mini--Inject#1, from Matt Lanier) * improved some docs (AndyA/CPAN--Mini--Inject#18, from Tim Bunce) * verbose now reports each time a module is injected (AndyA/CPAN--Mini--Inject#21, from Wolfgang Pecho) * repo is now https://github.com/briandfoy/cpan-mini-inject . Added GitHub workflows too. * tests can now be run in parallel. 0.37 2023-06-06 * add a test dependency 0.36 2023-06-06 * implement compatibility with new toolchain cpan_path regime * skip permission tests on cygwin 0.35 2017-07-19 * use Net::EmptyPort to find an empty port to use instead of a hard-coded one 0.34 2017-07-18 Konstantin Yakunin : * sort packages case insensitively 0.33 2013-07-30 Wolfgang Pecho : * allow spaces in configuration file 0.32 2013-04-17 Karen Etheridge : * add link for mcpani Randy Stauner : * Add module name to verbose "injected" message Salve J. Nilsen : * Inject distributions once per file instead of once per module 0.31 2011-10-10 Randy Stauner : * outsource module discovery to Dist::Metadata * moved module discovery from script to CPAN::Mini::Inject 0.30 2011-06-13 * keep just the last added module, even if there was one in 02packages.details.txt before we injected (Paul Driver ) * documentation fix (Randy Stauner ) 0.29 2011-05-15 * Skip tests that are unreliable under a DNS regime where any hostname resolves. * RT 63350 - Anchor the regex to filter old modules * RT 55463 - Don't use .bak for test files * RT 63407 - Win32 fixes related to file locks in tests * Changed tests so they'll be able to deal with read-only dist files 0.27 2010-01-28 All the following are thanks to Jozef Kutej : * --discover-packages option added to parse .pm files inside --file and extract package names andV versions. * allow CHECKSUMS signing. * keep just last added module version in 02packages.details.txt. 0.26 2009-06-15 * Specify minimum File::Path version 0.25 2009-05-29 * Move to GitHub 0.24 2009-05-10 * Made tests use a port (11027) other than 8080 to avoid clashes with existing services. 0.23 2008-10-25 * Rebundled to remove OS X extended attributes that were causing tests to fail. 0.22 2008-06-25 * fixed a bug where authors were being added more than once to 01mailrc.txt.gz 0.21 2008-06-25 * changes for RT bug 17386 by: David Bartle 0.20 2008-06-25 * added a command line option '--all-in-meta' which will parse the META.yml and index every module listed in the 'provides' section * module name and version is now parsed correctly from the filename if relative or absolute paths are specified * changes for RT bug 37093 by: David Bartle 0.18.1 2008-06-25 * Fixed bug number 28363 http://rt.cpan.org/Ticket/Display.html?id=28363 0.18 2005-04-02 * Fixed bug number 11718 involving the Line-Count in 02packages.details.txt.gz not being updated. * Added tests for update_mirror method. * Migrated tests to HTTP::Server::Simple. 0.16 2005-01-08 * Decreased the size of t/read/authors/01mailrc.txt.gz reducing greatly the size of the package. * More problems discovered with exception testing. Moved all exception tests to a single zz.exceptions.t, skip them all if Test::Exception isn't installed. 0.14 2005-01-05 * Added an optional filename parameter to parsecfg. This allows calling parsecfg without having to previously call loadcfg (tests added as required). * Updated Synopsis to not using method chaining, but documented that it is possible. * Updated prereq of CPAN::Mini to version 0.32 * Fixed a warning message if dirmode isn't configured during the inject process. * Fixed update_mirror to call CPAN::Mini->update_mirror directly fixing a problem with CPAN::Mini::Inject and the latest version of CPAN::Mini (0.32). 0.12 2005-01-04 * Tests failed for inject and add on Windows systems. These tests have now been skipped. * Reverted all tests to use eval{}. Using eval "" caused problems on Windows, while eval{} only caused problems on one AIX box. 0.10 2004-12-30 * Fixed dirmode in inject(), add(), writelist(), so that all files created are set with the correct permissions. * Added tests for directory and file modes. 0.08 2004-12-08 * Tests were found to fail on AIX which contained eval{}, all tests updated with eval "". * Added a default value for dirmode in update_mirror based on umask. * Added a dirmode option to the config file. * Fixed regex in mcpani to allow for developer version numbers with add (ie. CPAN-Mini-Inject-0.07_001). * Add a prereq for CPAN::Mini version 0.24. This version contains a bugfix to properly handle dirmode. (Thanks RJBS). 0.06 2004-11-10 * mcpani now parses the file passed to it to determine module name and version. Command line options override the parsing. * loadcfg() croaks if no configuration file is found. 0.04 2004-11-05 * t/readlist.t and t/writelist.t both skip failure tests if the uid is 0. * inject accepts a true parameter to enable verbose mode which lists modules as they are injected. * testremote accepts a true parameter to enable verbose mode which display the site being tested, and which is selected. * Added --passive switch to mcpani to enable passive ftp * Minor updates to perldoc in mcpani * Added CPAN::Mini as a required module to Makefile.PL 0.02 2004-10-31 * First version, released on an unsuspecting world. CPAN-Mini-Inject-1.012/MANIFEST0000644000076500000240000000240514773404623014464 0ustar brianstaffbin/mcpani Changes lib/CPAN/Mini/Inject.pm lib/CPAN/Mini/Inject/Config.pm Makefile.PL MANIFEST MANIFEST.SKIP README.pod SECURITY.md t/.mcpani/config t/.mcpani/config_bad t/.mcpani/config_badremote t/.mcpani/config_mcpi t/.mcpani/config_noread t/.mcpani/config_norepo t/.mcpani/config_nowrite t/.mcpani/config_with_whitespaces t/add-multiple.t t/add.t t/exceptions.t t/html/01mailrc.txt.gz t/html/02packages.details.txt.gz t/html/03modlist.data.gz t/html/CHECKSUMS t/html/CPAN-Mini-2.1828.tar.gz t/html/CPAN-Mini-Inject-1.01.tar.gz t/html/index.html t/inject.t t/lib/Local/localserver.pm t/lib/Local/utils.pm t/loadcfg.t t/local/01mailrc.txt.gz.original t/local/CPAN/modules/02packages.details.txt.gz.original t/local/mymodules/App-runscript-v1.0.0_02.tgz t/local/mymodules/CPAN-Mini-0.17.tar.gz t/local/mymodules/CPAN-Mini-Inject-0.01.tar.gz t/local/mymodules/Dist-Metadata-Test-MetaFile-2.2.tar.gz t/local/mymodules/Dist-Metadata-Test-MetaFile-Only.tar.gz t/local/mymodules/not-discoverable.tar.gz t/new.t t/parsecfg.t t/pod-coverage.t t/pod.t t/private.t t/readlist.t t/testremote.t t/update_mirror.t t/writelist.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) CPAN-Mini-Inject-1.012/t/0000755000076500000240000000000014773404622013574 5ustar brianstaffCPAN-Mini-Inject-1.012/t/pod.t0000644000076500000240000000020114773404621014533 0ustar brianstaffuse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); CPAN-Mini-Inject-1.012/t/parsecfg.t0000644000076500000240000000431014773404621015550 0ustar brianstaffuse strict; use warnings; use Test::More; use File::Spec::Functions qw(catfile); my $class = 'CPAN::Mini::Inject'; subtest sanity => sub { use_ok $class or BAIL_OUT( "$class did not compile: $@" ); }; subtest 'no loadcfg' => sub { my $mcpi = $class->new; isa_ok $mcpi, $class; can_ok $mcpi, 'parsecfg'; my $file = catfile qw(t .mcpani config); ok -e $file, "file <$file> exists"; $mcpi->parsecfg( $file ); ok exists $mcpi->{config}, 'config key exists'; can_ok $mcpi, 'config'; isa_ok $mcpi->config, ref {}, 'config returns a hash ref'; is $mcpi->config->{local}, 't/local/CPAN', 'value for local matches'; is $mcpi->config->{remote}, 'http://localhost:11027', 'value for remote matches'; is $mcpi->config->{repository}, 't/local/MYCPAN', 'value for repository matches'; }; subtest 'loadcfg' => sub { my $mcpi = $class->new; isa_ok $mcpi, $class; can_ok $mcpi, 'loadcfg'; my $file = catfile qw(t .mcpani config); ok -e $file, "config file <$file> exists"; $mcpi->loadcfg( $file ); $mcpi->parsecfg; ok exists $mcpi->{config}, 'config key exists'; can_ok $mcpi, 'config'; isa_ok $mcpi->config, ref {}, 'config returns a hash ref'; is $mcpi->config->{local}, 't/local/CPAN', 'value for local matches'; is $mcpi->config->{remote}, 'http://localhost:11027', 'value for remote matches'; is $mcpi->config->{repository}, 't/local/MYCPAN', 'value for repository matches'; }; subtest 'whitespace' => sub { my $mcpi = $class->new; isa_ok $mcpi, $class; my $file = catfile qw(t .mcpani config_with_whitespaces); ok -e $file, "file <$file> exists"; $mcpi->parsecfg( $file ); is $mcpi->config->{local}, 't/local/CPAN', 'value for local matches'; is $mcpi->config->{remote}, 'http://localhost:11027', 'value for remote matches'; is $mcpi->config->{repository}, 't/local/MYCPAN', 'value for repository matches'; is $mcpi->config->{dirmode}, '0775', 'value for dirmode matches'; is $mcpi->config->{passive}, 'yes', 'value for passive matches'; }; done_testing(); CPAN-Mini-Inject-1.012/t/inject.t0000644000076500000240000002077514773404621015247 0ustar brianstaffuse strict; use warnings; use Test::More; use File::Path qw(make_path); use File::Copy; use File::Temp (); use File::Basename; use File::Spec::Functions qw(catfile); use Compress::Zlib; use lib qw(t/lib); use Local::utils; my $class = 'CPAN::Mini::Inject'; my $temp_dir = File::Temp::tempdir(CLEANUP=>1); =begin comment C is the URL for the repo from which we'll download latest versions C is our MiniCPAN C is the dir where we will keep the modules to inject =end comment =cut subtest 'sanity' => sub { use_ok $class or BAIL_OUT( "Could not load $class: $@" ); can_ok $class, 'new'; isa_ok $class->new, $class; }; subtest 'setup directories in temp dir' => sub { my @dirs = ( [ qw(modules) ], [ qw(authors) ], [ qw(injects) ], ); foreach my $dir ( @dirs ) { my $path = catfile $temp_dir, @$dir; make_path( $path ); ok -d $path, "Path for <@$dir> exists"; } }; my $t_local = catfile qw(t local); subtest 'check local dir' => sub { ok -d $t_local, 'local directory exists'; }; subtest 'copy initial files' => sub { my $modules_base = catfile $temp_dir, 'modules'; ok -d $modules_base, 'modules dir exists'; my $authors_base = catfile $temp_dir, 'authors'; ok -d $authors_base, 'authors dir exists'; subtest 'packages' => sub { my $file = '02packages.details.txt.gz'; my $destination = catfile $modules_base, $file; my $rc = copy( catfile( $t_local, 'CPAN', 'modules', "$file.original" ), $destination ); ok $rc, 'File::Copy worked'; ok -e $destination, 'Copied packages file to temp_dir'; ok chmod(0666, $destination), 'chmod packages to 0666'; }; subtest 'mailrc' => sub { my $file = '01mailrc.txt.gz'; my $destination = catfile $authors_base, $file; my $rc = copy( catfile( $t_local, "$file.original" ), $destination ); ok $rc, 'File::Copy worked'; ok -e $destination, 'Copied mailrc file to temp_dir'; ok chmod(0666, $destination), 'chmod mailrc to 0666'; }; }; sub get_module_details { my( $dist_sources ) = @_; my @modules = ( { module => 'CPAN::Mini::Inject', authorid => 'SSORICHE', version => '0.01', file => catfile( $dist_sources, 'CPAN-Mini-Inject-0.01.tar.gz' ), }, { module => 'CPAN::Mini::Inject', authorid => 'SSORICHE', version => '0.02', file => catfile( $dist_sources, 'CPAN-Mini-Inject-0.01.tar.gz' ), }, { module => 'CPAN::Mini', authorid => 'RJBS', version => '0.17', file => catfile( $dist_sources, 'CPAN-Mini-0.17.tar.gz' ), }, ); } sub test_inject { my( $mcpi, @modules ) = @_; foreach my $module ( @modules ) { ok -e $module->{file}, "module file <$module->{file}> exists"; $mcpi = $mcpi->add( %$module ); } subtest 'writelist' => sub { ok $mcpi->writelist, 'inject modules'; }; subtest 'inject' => sub { ok $mcpi->inject( $ENV{TEST_VERBOSE} // 0 ), 'copy modules'; }; subtest 'packages' => sub { my $packages = catfile $temp_dir, 'modules', '02packages.details.txt.gz'; ok -e $packages, '02packages exists'; my $gz = gzopen($packages, 'rb'); my $line; my $expected_lines; HEADER: while( $gz->gzreadline($line) > 0 ) { last HEADER if $line eq "\n"; my $rc = like $line, qr/\A ([a-z-]+) : \x{20}+ (.*)/ix, 'header format is correct'; if( $line =~ m/\A ([a-z-]+) : \x{20}+ (.*)/ix and $1 eq 'Line-Count') { $expected_lines = $2; } } my $count = 0; PACKAGES: while( $gz->gzreadline($line) > 0 ) { $count++; chomp($line); my( $module, $version, $path ) = split /\s+/, $line; like $module, qr/\A [A-Za-z0-9_]+ (:: [A-Za-z0-9_]+ )* \z/x, 'module name matches'; } is $count, $expected_lines, 'Line-Count matches lines'; }; subtest 'check the result' => sub { my $authors_dir = catfile $temp_dir, 'authors'; ok -e $authors_dir, 'authors dir exists'; foreach my $module ( @modules ) { subtest "check $module->{file}" => sub { my $author_stub = catfile( $authors_dir, 'id', substr( $module->{authorid}, 0, 1 ), substr( $module->{authorid}, 0, 2 ), $module->{authorid} ); ok -d $author_stub, "author directory $author_stub for $module->{authorid} exists"; is( mode($author_stub), 0775, 'author dir mode is 775' ) if has_modes(); my $module_basename = basename $module->{file}; my $module_path = catfile $author_stub, $module_basename; ok -e $module_path, "$module_basename exists in local"; is( mode($module_path), 0664, 'moduole filr is mode is 664' ) if has_modes(); subtest 'CHECKSUMS' => sub { my $checksums_path = catfile $author_stub, 'CHECKSUMS'; my $rc = ok -e $checksums_path, "CHECKSUMS file for $module->{authorid} exists"; is( mode($checksums_path), 0664, 'checksum file mode is 664' ) if has_modes(); if( $rc ) { my $rc = open my $chk, '<', $checksums_path; my $checksum_text = join "", <$chk>; close $chk; unlike $checksum_text, qr{\Q$authors_dir\E/id}, "root path isn't leaked to checksums"; } else { fail "Can't check CHECKSUMS since it doesn't exist"; } }; }; } }; }; subtest 'inject the modules' => sub { my $dist_sources = catfile $t_local, 'mymodules'; ok -d $dist_sources, 'Dist sources directory exists'; my @modules = get_module_details( $dist_sources ); my $tmp_config_file; subtest 'make config' => sub { $tmp_config_file = write_config( local => $temp_dir, repository => catfile( $temp_dir, 'injects' ), ); ok -e $tmp_config_file, 'configuration file exists'; }; my $mcpi = $class->new; isa_ok $mcpi, $class; $mcpi = $mcpi->loadcfg( $tmp_config_file )->parsecfg->readlist; test_inject( $mcpi, @modules ); }; subtest 'packages updated' => sub { my @goodfile = ; my $packages = catfile $temp_dir, 'modules', '02packages.details.txt.gz'; ok -e $packages, 'packages files exists'; ok( my $gzread = gzopen( $packages, 'rb' ), 'opened packages for reading' ); my @packages; my $line; while ( $gzread->gzreadline( $line ) ) { if ( $line =~ /^Written-By:/ ) { push( @packages, "Written-By:\n" ); next; } if ( $line =~ /^Last-Updated:/ ) { push( @packages, "Last-Updated:\n" ); next; } push( @packages, $line ); } $gzread->gzclose; is_deeply( \@goodfile, \@packages, 'got expected packages file data' ); }; subtest 'mailrc updated' => sub { my $mailrc = catfile $temp_dir, 'authors', '01mailrc.txt.gz'; ok -e $mailrc, 'mailrc files exists'; ok( my $gzauthread = gzopen( $mailrc, 'rb' ), 'opened mailrc for reading' ); my %inject_authors = map { $_->{authorid} => 1 } get_module_details(''); my $line; my %found_authors; while ( $gzauthread->gzreadline( $line ) ) { next unless $line =~ /\A alias \h+ ([A-Z]+)/x; $found_authors{$1}++; fail( "Found $1 $found_authors{$1} times" ) if $found_authors{$1} > 1; } $gzauthread->gzclose; foreach my $author ( keys %inject_authors ) { ok exists $found_authors{$author}, "Found $author in $mailrc"; } }; subtest 'empty local' => sub { my $dist_sources = catfile $t_local, 'mymodules'; ok -d $dist_sources, 'Dist sources directory exists'; my @modules = get_module_details( $dist_sources ); my $empty_temp_dir = File::Temp::tempdir(CLEANUP=>1); my $tmp_config_file; subtest 'make config' => sub { $tmp_config_file = write_config( local => $empty_temp_dir, repository => catfile( $temp_dir, 'injects' ), ); ok -e $tmp_config_file, 'configuration file exists'; }; my $mcpi = $class->new; isa_ok $mcpi, $class; $mcpi = $mcpi->loadcfg( $tmp_config_file )->parsecfg->readlist; my $warnings; local $SIG{__WARN__} = sub { $warnings = $_[0] }; test_inject( $mcpi, @modules ); like $warnings, qr/02packages.details.txt.gz> does not exist/, 'saw warning about missing package file'; }; done_testing(); __DATA__ File: 02packages.details.txt URL: http://www.perl.com/CPAN/modules/02packages.details.txt Description: Package names found in directory $CPAN/authors/id/ Columns: package name, version, path Intended-For: Automated fetch routines, namespace documentation. Written-By: Line-Count: 7 Last-Updated: abbreviation 0.02 M/MI/MIYAGAWA/abbreviation-0.02.tar.gz Acme::Code::Police 2.1828 O/OV/OVID/Acme-Code-Police-2.1828.tar.gz BFD 0.31 R/RB/RBS/BFD-0.31.tar.gz CPAN::Mini 0.17 R/RJ/RJBS/CPAN-Mini-0.17.tar.gz CPAN::Mini::Inject 0.02 S/SS/SSORICHE/CPAN-Mini-Inject-0.01.tar.gz CPAN::Nox 1.02 A/AN/ANDK/CPAN-1.76.tar.gz CPANPLUS 0.049 A/AU/AUTRIJUS/CPANPLUS-0.049.tar.gz CPAN-Mini-Inject-1.012/t/update_mirror.t0000644000076500000240000000626514773404621016645 0ustar brianstaffuse strict; use warnings; use Test::More; use CPAN::Mini::Inject; use File::Path; use File::Spec::Functions; use File::Temp (); use lib 't/lib'; use Local::localserver; use Local::utils; # if either of these happen, we don't want the tests to fail. $SIG{'INT'} = $SIG{'TERM'} = sub { print "\nCleaning up before exiting\n"; done_testing(); exit }; my $tmp_dir = File::Temp::tempdir( CLEANUP => 1 ); my $tmp_config_file; # some CPAN testers had problems with this unless( -w $tmp_dir ) { diag("/tmp was not writeable, so not continuing"); pass(); exit; } my $url; my $port; my $pid; subtest 'start local server' => sub { $port = empty_port(); ( $pid ) = start_server($port); diag( "$$: PORT: $port" ) if $ENV{TEST_VERBOSE}; diag( "$$: PID: $pid" ) if $ENV{TEST_VERBOSE}; $url = "http://localhost:$port/"; foreach ( 1 .. 4 ) { my $sleep = $_ * 2; sleep $sleep; diag("Sleeping $sleep seconds waiting for server") if $ENV{TEST_VERBOSE}; last if can_fetch($url); } ok can_fetch($url), "URL $url is available"; }; subtest 'make config' => sub { $tmp_config_file = write_config( local => catfile( qw(t local CPAN) ), remote => $url, repository => $tmp_dir, ); diag("Temp file is <$tmp_config_file>") if $ENV{TEST_VERBOSE}; ok -e $tmp_config_file, " exists"; }; my $mcpi; subtest 'setup' => sub { my $class = 'CPAN::Mini::Inject'; use_ok $class; $mcpi = $class->new; isa_ok $mcpi, $class; }; subtest 'testremote' => sub { $mcpi->loadcfg( $tmp_config_file )->parsecfg; $mcpi->{config}{remote} =~ s/:\d{5}\b/:$port/; ok can_fetch($url), "URL $url is available"; eval { $mcpi->testremote } or print STDERR "testremote died: $@"; ok can_fetch($url), "URL $url is still available"; is( $mcpi->{site}, $url, "Site URL is $url" ); }; subtest 'update mirror' => sub { ok( -e $tmp_dir, 'mirror directory exists' ); # a couple of CPAN Testers have this problem. unless( -w $tmp_dir ) { diag( "temp dir is not writable? Skipping these tests" ); return; } ok can_fetch($url), "URL $url is available"; eval { $mcpi->update_mirror( remote => $url, local => $tmp_dir, trace => 1, log_level => 'error', verbose => 0, ); } or diag( "update_mirror died: $@" ); }; subtest 'mirror state' => sub { unless( -w $tmp_dir ) { diag( "temp dir is not writable? Skipping these tests" ); return; } ok -e catfile( $tmp_dir, qw(authors) ), 'authors/ exists'; ok -e catfile( $tmp_dir, qw(modules) ), 'modules/ exists'; ok -e catfile( $tmp_dir, qw(authors 01mailrc.txt.gz) ), '01mailrc.txt.gz exists'; ok -e catfile( $tmp_dir, qw(modules 02packages.details.txt.gz) ), '02packages.details.txt.gz exists'; ok -e catfile( $tmp_dir, qw(modules 03modlist.data.gz) ), '03modlist.data.gz exists'; ok -e catfile( $tmp_dir, qw(authors id R RJ RJBS CHECKSUMS) ), 'RJBS/CHECKSUMS exists'; ok -e catfile( $tmp_dir, qw(authors id R RJ RJBS CPAN-Mini-2.1828.tar.gz) ), 'CPAN-Mini-2.1828.tar.gz exists'; ok -e catfile( $tmp_dir, qw(authors id S SS SSORICHE CHECKSUMS) ), 'SSORICHE/CHECKSUMS exists'; ok -e catfile( $tmp_dir, qw(authors id S SS SSORICHE CPAN-Mini-Inject-1.01.tar.gz) ), 'CPAN::Mini::Inject exixts'; }; kill 9, $pid; done_testing(); CPAN-Mini-Inject-1.012/t/add.t0000644000076500000240000000475414773404621014522 0ustar brianstaffuse strict; use warnings; use Test::More; use File::Path qw(make_path); use File::Spec::Functions qw(catfile); use File::Temp; use lib 't/lib'; use Local::localserver; use Local::utils; my $class = 'CPAN::Mini::Inject'; $SIG{'INT'} = sub { print "\nCleaning up before exiting\n"; exit 1 }; my $temp_dir = File::Temp::tempdir(CLEANUP=>1); subtest 'sanity' => sub { use_ok $class or BAIL_OUT( "Could not load $class: $@" ); can_ok $class, 'new'; isa_ok $class->new, $class; }; my $repo_dir = catfile $temp_dir, 'injects'; subtest 'create directory' => sub { make_path $repo_dir; ok -e $repo_dir, 'repository dir exists' }; my $tmp_config_file = catfile $temp_dir, 'config'; subtest 'make config' => sub { my $fh; if( open $fh, '>', $tmp_config_file ) { print {$fh} <<"HERE"; local: $temp_dir remote : http://localhost:11027 repository: $repo_dir dirmode: 0775 passive: yes HERE close $fh; pass( "created config file" ); } else { fail("Could not create config file. Cannot continue"); done_testing(); exit; } }; subtest 'add' => sub { my $mcpi = $class->new; isa_ok $mcpi, $class; can_ok $mcpi, 'add'; ok -e $tmp_config_file, 'config file exists'; $mcpi->loadcfg( $tmp_config_file )->parsecfg; my $archive_file = 'CPAN-Mini-Inject-0.01.tar.gz'; my $archive_path = catfile qw(t local mymodules), $archive_file; my $module = $class; ok( -e $archive_path, "file <$archive_file> exists" ); my $author = 'SSORICHE'; ok $mcpi->add( module => $module, authorid => $author, version => '0.01', file => $archive_path )->add( module => $module, authorid => $author, version => '0.02', file => $archive_path ), 'adding twice succeeded'; ok exists $mcpi->{modulelist}, 'modulelist key exists'; isa_ok $mcpi->{modulelist}, ref [], 'modulelist value is an array ref'; is scalar @{$mcpi->{modulelist}}, 1, 'modulelist array has one entry'; like $mcpi->{modulelist}[0], qr/\A\Q$module\E/, "modulelist entry has $module"; my $author_path = catfile $repo_dir, qw(authors id), substr( $author, 0, 1 ), substr( $author, 0, 2 ), $author; ok -e $author_path, "author directory for $author exists"; is( mode($author_path), 0775, 'author dir mode is 775' ) if has_modes(); my $repo_archive_path = catfile $author_path, $archive_file; ok -e $repo_archive_path, 'archive exists in repository'; is( mode($repo_archive_path), 0664, 'archive path is mode is 664' ) if has_modes(); ok -r $repo_archive_path, 'archive in repository is readable'; }; done_testing(); CPAN-Mini-Inject-1.012/t/testremote.t0000644000076500000240000000327314773404621016160 0ustar brianstaffuse strict; use warnings; use Test::More; use CPAN::Mini::Inject; use lib 't/lib'; use Local::localserver; # if either of these happen, we don't want the tests to fail. $SIG{'INT'} = $SIG{'TERM'} = sub { print "\nCleaning up before exiting\n"; done_testing(); exit 0 }; my $port = empty_port(); like $port, qr/\A\d+\z/a, 'port looks like a number'; my( $pid ) = start_server($port); diag( "$$: PORT: $port" ) if $ENV{TEST_VERBOSE}; diag( "$$: PID: $pid" ) if $ENV{TEST_VERBOSE}; my $url = "http://localhost:$port/"; my $available = 0; foreach ( 1 .. 4 ) { my $sleep = $_ ** 2; sleep $sleep; diag("Sleeping $sleep seconds waiting for server") if $ENV{TEST_VERBOSE}; if( can_fetch($url) ) { $available = 1; last; } elsif( ! kill 0, $pid ) { diag("Server pid is gone") if $ENV{TEST_VERBOSE}; last; } } # Sometime the server does not come up, but we don't want that to # stand in the way of people who want to use this. unless( $available ) { diag( "Server never came up. Not attempting to test it." ); done_testing(); exit 0; } ok can_fetch($url), "URL $url is available"; my $mcpi = CPAN::Mini::Inject->new; $mcpi->loadcfg( 't/.mcpani/config' )->parsecfg; $mcpi->{config}{remote} =~ s/:\d{5}\b/:$port/a; $mcpi->testremote; is $mcpi->{site}, $url, "Site URL is $url"; ok can_fetch($url), "URL $url is available"; $mcpi->loadcfg( 't/.mcpani/config_badremote' )->parsecfg; $mcpi->{config}{remote} =~ s/:\d{5}\b/:$port/a; SKIP: { skip 'Test fails with funky DNS providers', 1 if can_fetch( 'http://blahblah' ); # This fails with OpenDNS &c $mcpi->testremote; is $mcpi->{site}, $url, 'Selects correct remote URL'; } kill 9, $pid; unlink( 't/testconfig' ); done_testing(); CPAN-Mini-Inject-1.012/t/exceptions.t0000644000076500000240000002336214773404621016147 0ustar brianstaffuse strict; use warnings; use Test::More; BEGIN { eval "use Test::Exception"; plan skip_all => "Test::Exception required for exceptions.t" if $@; } use File::Spec::Functions qw(catfile); use File::Path qw(make_path); use File::Temp (); use Socket qw(getaddrinfo); use lib 't/lib'; use Local::utils; my $class = 'CPAN::Mini::Inject'; $SIG{'INT'} = sub { print "\nCleaning up before exiting\n"; exit 1 }; my $temp_dir = File::Temp::tempdir(CLEANUP=>1); subtest 'sanity' => sub { use_ok $class or BAIL_OUT( "Could not load $class: $@" ); can_ok $class, 'new'; isa_ok $class->new, $class; }; subtest 'config problems' => sub { subtest 'no config' => sub { delete local $ENV{HOME}; delete local $ENV{MCPANI_CONFIG}; SKIP: { skip 'Global config file exists. Cannot test no config situation.', 1 if global_config_exists(); my $mcpi = $class->new; isa_ok $mcpi, $class; dies_ok { $mcpi->loadcfg } 'No config file'; } }; subtest 'bad config' => sub { my $tmp_config_file = catfile $temp_dir, 'bad_config'; subtest 'create bad config file' => sub { my $fh; if( open $fh, '>', $tmp_config_file ) { print {$fh} <<'HERE'; # This file is missing a local setting. remote : http://www.cpan.org repository: t/local/MYCPAN passive: yes This line will be ignored HERE ok close($fh), "created bad config file"; } else { fail("could not create config with missing local setting"); } }; ok -e $tmp_config_file, 'bad config with missing local setting file exists'; my $mcpi = $class->new; isa_ok $mcpi, $class; local $SIG{__WARN__} = sub {1}; # suppress warning about "This line will be ignored" dies_ok { $mcpi->parsecfg( $tmp_config_file ); } 'Missing local setting blows up'; }; subtest 'unreadable' => sub { SKIP: { skip 'User is superuser and can always read', 1 if $< == 0; skip 'User is generally superuser under cygwin and can read', 1 if $^O eq 'cygwin'; my $repo_dir = catfile $temp_dir, 'injects'; ok make_path($repo_dir), "make_path for injects/ succeeded"; my $tmp_config_file = catfile $temp_dir, 'bad_config'; my $fh; if(open $fh, '>', $tmp_config_file) { print {$fh} "Hello"; close $fh; chmod 0111, $tmp_config_file; is( mode($tmp_config_file), 0111, 'mode for config is 0111' ); ok -e $tmp_config_file, 'config file exists'; ok ! -r $tmp_config_file, 'config file is not readable'; } else { fail("Could not create an unreadable file"); } my $mcpi = $class->new; isa_ok $mcpi, $class; dies_ok { $mcpi->parsecfg($tmp_config_file) } 'unreadable file'; like $@, qr/Could not read file/, 'exception has expected message'; chmod 0644, $tmp_config_file; } }; subtest 'no repo config' => sub { my $tmp_config_file = catfile $temp_dir, 'bad_config'; subtest 'create no repo config file' => sub { my $fh; if(open $fh, '>', $tmp_config_file) { print {$fh} "local: t/local/CPAN\nremote: http://www.cpan.org\n"; close $fh; ok -e $tmp_config_file, 'config file exists'; ok -r $tmp_config_file, 'config file is readable'; } else { fail("Could not create no repo config file"); } }; my $mcpi = $class->new; isa_ok $mcpi, $class; lives_ok { $mcpi->parsecfg($tmp_config_file) } 'no repo config file parses'; dies_ok { $mcpi->add( module => 'CPAN::Mini::Inject', authorid => 'SSORICHE', version => '0.01', file => 'test-0.01.tar.gz' ); } 'Missing config repository'; like $@, qr/no repository configured/, 'exception has expected message'; }; subtest 'read-only repo' => sub { SKIP: { skip 'this system does not do file modes', 3 unless has_modes(); my $tmp_config_file = catfile $temp_dir, 'bad_config'; my $repo_dir = catfile $temp_dir, 'read-only-injects'; subtest 'create read-only repo dir' => sub { ok make_path($repo_dir), 'created repo dir'; chmod 0555, $repo_dir; is mode($repo_dir), 0555, 'repo dir has mode 444'; ok ! -w $repo_dir, 'repo dir is not writable'; }; subtest 'create read-only repo config file' => sub { my $fh; if(open $fh, '>', $tmp_config_file) { print {$fh} <<"HERE"; local: $temp_dir remote: http://www.cpan.org repository: $repo_dir HERE close $fh; ok -e $tmp_config_file, 'config file exists'; ok -r $tmp_config_file, 'config file is readable'; } else { fail("Could not create read-only repo config file"); } }; subtest 'try to add to read-only repo' => sub { my $mcpi = $class->new; isa_ok $mcpi, $class; lives_ok { $mcpi->parsecfg($tmp_config_file) } 'read-only repo config file parses'; dies_ok { $mcpi->add( module => 'CPAN::Mini::Inject', authorid => 'SSORICHE', version => '0.01', file => 'test-0.01.tar.gz' ); } 'read-only repository'; like $@, qr/cannot write to repository/, 'exception has expected message'; }; chmod 755, $repo_dir; }; } }; subtest 'add exceptions' => sub { my $repo_dir = catfile $temp_dir, 'injects'; subtest 'create repo dir' => sub { ok make_path($repo_dir), 'created repo dir' unless -d $repo_dir; chmod 0755, $repo_dir; is mode($repo_dir), 0755, 'repo dir has mode 444' if has_modes(); ok -r $repo_dir, 'repo dir is readable'; ok -w $repo_dir, 'repo dir is writable'; }; my $tmp_config_file = catfile $temp_dir, 'good_config'; subtest 'create config file' => sub { my $fh; if(open $fh, '>', $tmp_config_file) { print {$fh} <<"HERE"; local: $temp_dir remote : http://localhost:11027 repository: $repo_dir dirmode: 0775 passive: yes HERE close $fh; ok -e $tmp_config_file, 'config file exists'; ok -r $tmp_config_file, 'config file is readable'; } else { fail("Could not create config file"); } }; my $mcpi = $class->new; isa_ok $mcpi, $class; lives_ok { $mcpi->parsecfg( $tmp_config_file ) } 'parsecfg works'; subtest 'missing file param' => sub { dies_ok { $mcpi->add( module => 'CPAN::Mini::Inject', authorid => 'SSORICHE', version => '0.01' ); } 'Missing add param'; like $@, qr/required option not specified: file/, 'exception has expected message'; }; subtest 'module file is missing' => sub { dies_ok { $mcpi->add( module => 'CPAN::Mini::Inject', authorid => 'SSORICHE', version => '0.01', file => 'blahblah' ); } 'Module file not readable'; like $@, qr/cannot read module file: blahblah/, 'exception has expected message'; }; subtest 'discoverable' => sub { lives_ok { $mcpi->add( authorid => 'RWSTAUNER', file => 't/local/mymodules/Dist-Metadata-Test-MetaFile-Only.tar.gz' ); } 'Ok without module/version when discoverable'; }; subtest 'not discoverable' => sub { lives_ok { $mcpi->add( module => 'Who::Cares', version => '1', authorid => 'RWSTAUNER', file => 't/local/mymodules/not-discoverable.tar.gz' ); } 'Ok without module/version when specified'; }; subtest 'needs module and version when not discoverable' => sub { dies_ok { $mcpi->add( authorid => 'RWSTAUNER', file => 't/local/mymodules/not-discoverable.tar.gz' ); } 'Dies without module/version when not discoverable'; }; }; subtest 'remote problems' => sub { my $repo_dir = catfile $temp_dir, 'injects'; subtest 'create repo dir' => sub { ok make_path($repo_dir), 'created repo dir' unless -d $repo_dir; chmod 0755, $repo_dir; is mode($repo_dir), 0755, 'repo dir has mode 755' if has_modes(); ok -r $repo_dir, 'repo dir is readable'; ok -w $repo_dir, 'repo dir is writable'; }; subtest 'unreachable remote' => sub { my $unreachable_host = 'com'; my $url = 'http://$host/'; my ($lookup_error, @result) = getaddrinfo $unreachable_host, 'http'; SKIP: { plan skip_all => 'bad host resolves, so cannot test that' unless $lookup_error; my $tmp_config_file = catfile $temp_dir, 'good_config'; subtest 'create config file' => sub { my $fh; if(open $fh, '>', $tmp_config_file) { print {$fh} <<"HERE"; local: $temp_dir remote: $url repository: $repo_dir dirmode: 0775 passive: yes HERE close $fh; ok -e $tmp_config_file, 'config file exists'; ok -r $tmp_config_file, 'config file is readable'; } else { fail("Could not create config file"); } }; my $mcpi = $class->new; isa_ok $mcpi, $class; lives_ok { $mcpi->parsecfg( $tmp_config_file ) } 'parsecfg works'; diag "trying to connect to a bad site: this might take a minute"; dies_ok { $mcpi->testremote } 'No reachable site'; like $@, qr/unable to connect/, 'exception has expected message'; } }; }; # writelist() subtest 'writelist' => sub { SKIP: { skip 'User is superuser and can always write', 1 if $< == 0; skip 'User is generally superuser under cygwin and can write', 1 if $^O eq 'cygwin'; my $repo_dir = catfile $temp_dir, 'injects'; subtest 'create repo dir' => sub { ok make_path($repo_dir), 'created repo dir' unless -d $repo_dir; chmod 0555, $repo_dir; is mode($repo_dir), 0555, 'repo dir has mode 555'; ok -r $repo_dir, 'repo dir is readable'; ok ! -w $repo_dir, 'repo dir is not writable'; }; my $tmp_config_file = catfile $temp_dir, 'config'; subtest 'create config file' => sub { my $fh; if(open $fh, '>', $tmp_config_file) { print {$fh} <<"HERE"; local: $temp_dir remote : http://www.cpan.org repository: $repo_dir HERE close $fh; ok -e $tmp_config_file, 'config file exists'; ok -r $tmp_config_file, 'config file is readable'; } else { fail("Could not create config file"); } }; my $mcpi = $class->new; isa_ok $mcpi, $class; lives_ok { $mcpi->parsecfg( $tmp_config_file ) } 'parsecfg works'; dies_ok { $mcpi->writelist } 'fail write file'; like $@, qr//, 'exception has expected message'; } }; done_testing(); CPAN-Mini-Inject-1.012/t/private.t0000644000076500000240000000127514773404621015437 0ustar brianstaff#!perl use strict; use warnings; use CPAN::Mini::Inject; use Test::More; subtest '_fmtmodule' => sub { my @tests = ( { in => [ 'foo', 'foo.tar.gz', '0.01' ], out => 'foo 0.01 foo.tar.gz', }, { in => [ 'fooIsAModuleWithAReallyLongNameSoLong' . 'InFactThatItScrewsWithTheFormatting', 'foo.tar.gz', '0.01' ], out => 'fooIsAModuleWithAReallyLongNameSoLong' . 'InFactThatItScrewsWithTheFormatting 0.01 foo.tar.gz', }, ); for my $test ( @tests ) { my $got = CPAN::Mini::Inject::_fmtmodule( @{ $test->{in} } ); is $got, $test->{out}, '_fmtmodule'; } }; done_testing(); CPAN-Mini-Inject-1.012/t/writelist.t0000644000076500000240000000455114773404621016013 0ustar brianstaffuse strict; use warnings; use Test::More; use File::Path qw(make_path); use File::Spec::Functions qw(catfile); use File::Temp (); use lib qw(t/lib); use Local::utils; my $class = 'CPAN::Mini::Inject'; $SIG{'INT'} = sub { print "\nCleaning up before exiting\n"; exit 1 }; my $temp_dir = File::Temp::tempdir(CLEANUP=>1); subtest 'sanity' => sub { use_ok $class or BAIL_OUT( "Could not load $class: $@" ); isa_ok $class->new, $class; }; subtest 'setup directories in temp dir' => sub { my @dirs = ( [ qw(modules) ], [ qw(authors) ], [ qw(injects) ], ); foreach my $dir ( @dirs ) { my $path = catfile $temp_dir, @$dir; make_path( $path ); ok -d $path, "Path for <@$dir> exists"; } }; my $modulelist; subtest 'make modulelist' => sub { my $injects_dir = catfile $temp_dir, 'injects'; ok -e $injects_dir, 'injects directory exists'; $modulelist = catfile $injects_dir, 'modulelist'; my $fh; if( open $fh, '>', catfile $modulelist ) { print {$fh} <<'HERE'; CPAN::Checksums 1.016 A/AN/ANDK/CPAN-Checksums-1.016.tar.gz CPAN::Mini 0.18 R/RJ/RJBS/CPAN-Mini-0.18.tar.gz CPANPLUS 0.0499 A/AU/AUTRIJUS/CPANPLUS-0.0499.tar.gz HERE close $fh; } else { fail( "Could not open <$modulelist>: $!" ); } }; subtest 'add to modulelist' => sub { my $tmp_config_file; subtest 'make config' => sub { $tmp_config_file = write_config( local => $temp_dir, repository => catfile( $temp_dir, 'injects' ), ); ok -e $tmp_config_file, 'configuration file exists'; }; my $mcpi = $class->new; isa_ok $mcpi, $class; $mcpi->loadcfg( $tmp_config_file )->parsecfg->readlist; my $module_line = "CPAN::Mini::Inject 0.01 S/SS/SSORICHE/CPAN-Mini-Inject-0.01.tar.gz"; subtest 'modify modulelist' => sub { ok -e $modulelist, "modulelist file exists"; push( @{ $mcpi->{modulelist} }, $module_line ); is( @{ $mcpi->{modulelist} }, 4, 'Updated memory modulelist' ); ok( $mcpi->writelist, 'Write modulelist' ); }; subtest 'check modulelist' => sub { my $other_mcpi = $class->new; isa_ok $other_mcpi, $class; $mcpi->loadcfg( $tmp_config_file )->parsecfg->readlist; is( @{ $mcpi->{modulelist} }, 4, 'Updated memory modulelist' ); my $found = grep { $_ eq $module_line } @{ $mcpi->{modulelist} }; ok $found, "target line is in modulelist"; }; }; done_testing(); CPAN-Mini-Inject-1.012/t/new.t0000644000076500000240000000101314773404621014544 0ustar brianstaffuse strict; use warnings; use Test::More; use File::Spec::Functions qw(catfile); my $class = 'CPAN::Mini::Inject'; my $method = 'new'; subtest sanity => sub { use_ok $class or BAIL_OUT( "$class did not compile: $@" ); can_ok $class, $method; }; subtest 'no args' => sub { my $mcpi = $class->$method(); isa_ok $mcpi, $class; can_ok $class, 'default_config_class'; is $mcpi->config_class, $class->default_config_class, 'received the expected default config class'; can_ok $mcpi, 'config'; }; done_testing(); CPAN-Mini-Inject-1.012/t/html/0000755000076500000240000000000014773404622014540 5ustar brianstaffCPAN-Mini-Inject-1.012/t/html/index.html0000644000076500000240000000005514773404621016534 0ustar brianstaff

Index

CPAN-Mini-Inject-1.012/t/html/CPAN-Mini-Inject-1.01.tar.gz0000644000076500000240000000000514773404621021063 0ustar brianstaffTEST CPAN-Mini-Inject-1.012/t/html/CPAN-Mini-2.1828.tar.gz0000644000076500000240000000000514773404621020034 0ustar brianstaffTEST CPAN-Mini-Inject-1.012/t/html/03modlist.data.gz0000644000076500000240000000006514773404621017630 0ustar brianstaff@B03modlist.data30O,.KI,IKjHKCPAN-Mini-Inject-1.012/t/html/CHECKSUMS0000644000076500000240000000000514773404621016002 0ustar brianstaffTEST CPAN-Mini-Inject-1.012/t/html/01mailrc.txt.gz0000644000076500000240000000006114773404621017324 0ustar brianstaff?B01mailrc.txt30M)J+(KRCPAN-Mini-Inject-1.012/t/html/02packages.details.txt.gz0000644000076500000240000000054414773404621021266 0ustar brianstaffGB02packages.details.txtuAS0{H:2L@M:V_oJudFo_v+]IUn3$uS?5~t+mͧj+5醴5%`d65 dΎL:ϵVmmW07t>aLhnBϬ0n֒P܁-i~/ e˶FCǢg) ɡ6W"iHI fWBz׍ IHGP`Y\@d(s]>EQ!h2@ГxԸs#%ܼ{,I ^tϧw7'wo'}CPAN-Mini-Inject-1.012/t/readlist.t0000644000076500000240000000403014773404621015564 0ustar brianstaffuse strict; use warnings; use File::Path qw(make_path); use File::Spec::Functions qw(catfile); use File::Temp; use Test::More; my $class = 'CPAN::Mini::Inject'; subtest 'sanity' => sub { use_ok $class or BAIL_OUT("$class did not compile: $@"); can_ok $class, 'new'; }; $SIG{'INT'} = sub { print "\nCleaning up before exiting\n"; exit 1 }; my $temp_dir = File::Temp::tempdir(CLEANUP=>1); my $tmp_config_file = catfile $temp_dir, 'config'; my $repo_dir = catfile $temp_dir, 'injects'; subtest 'make repo dir' => sub { make_path $repo_dir; ok -e $repo_dir, "repository directory exists"; }; subtest 'make config' => sub { my $fh; if( open $fh, '>', $tmp_config_file ) { print {$fh} <<"HERE"; local: $temp_dir remote : http://localhost:11027 repository: $repo_dir dirmode: 0775 passive: yes HERE close $fh; pass( "created config file" ); } else { fail("Could not create config file. Cannot continue"); done_testing(); exit; } }; subtest 'make modulelist' => sub { my $modulelist_path = catfile $repo_dir, 'modulelist'; my $fh; if( open $fh, '>', $modulelist_path ) { print {$fh} <<"HERE"; CPAN::Checksums 1.016 A/AN/ANDK/CPAN-Checksums-1.016.tar.gz CPAN::Mini 0.18 R/RJ/RJBS/CPAN-Mini-0.18.tar.gz CPANPLUS 0.0499 A/AU/AUTRIJUS/CPANPLUS-0.0499.tar.gz HERE close $fh; pass( "created modulelist file" ); } else { fail("Could not create modulelist file. Cannot continue"); done_testing(); exit; } }; subtest 'readlist' => sub { my $mcpi = $class->new; isa_ok $mcpi, $class; can_ok $mcpi, 'readlist'; ok -e $tmp_config_file, 'config file exists'; ok $mcpi->loadcfg( $tmp_config_file )->parsecfg, 'parsecfg succeeded'; ok ! exists $mcpi->{modulelist}, "object does not have modulelist key yet"; $mcpi->readlist; ok exists $mcpi->{modulelist}, "object has modulelist key after readlist"; isa_ok $mcpi->{modulelist}, ref [], 'modulelist is an array ref after readlist'; is( @{ $mcpi->{modulelist} }, 3, 'read modulelist' ); }; done_testing(); CPAN-Mini-Inject-1.012/t/local/0000755000076500000240000000000014773404622014666 5ustar brianstaffCPAN-Mini-Inject-1.012/t/local/CPAN/0000755000076500000240000000000014773404622015407 5ustar brianstaffCPAN-Mini-Inject-1.012/t/local/CPAN/modules/0000755000076500000240000000000014773404622017057 5ustar brianstaffCPAN-Mini-Inject-1.012/t/local/CPAN/modules/02packages.details.txt.gz.original0000644000076500000240000000071514773404621025410 0ustar brianstaffX02packages.details.txt}Ao0s#4J(f-V;'_vhAZ:za<󳝅eNJӖWM:*$rU;#cÁִ2 m5kj\ʪўF@F:x54ee~;,k=CZ#}ThZHAfwhRjttas L5R#hdz~ -|J fFK vGL`'[H$Y|w(//V~) .٩ҷQ^52fFʟRL {UY #Gt1$Ue۩׎y #!XVqO`!A9hm>/GIʙGJc,wߝ&㶸/@F#:'CPAN-Mini-Inject-1.012/t/local/mymodules/0000755000076500000240000000000014773404622016704 5ustar brianstaffCPAN-Mini-Inject-1.012/t/local/mymodules/CPAN-Mini-0.17.tar.gz0000644000076500000240000000000014773404621022016 0ustar brianstaffCPAN-Mini-Inject-1.012/t/local/mymodules/Dist-Metadata-Test-MetaFile-2.2.tar.gz0000644000076500000240000000155614773404621025362 0ustar brianstaffX[o0ٿ(Ks$w7֋ItU2U$B9N g; M iyo9sw?n<8۪t羄\\p]\o5IAt(`kp-QO 歓pF͖j aF 5@ƌĔ€pi$Yl jmP*AZg/2wݯb&"Dp '䊂JD0WH'DR1e#,B4>$~cYO>`y} MDAha*UY(JeLlAʴ 3 "ƶPU>`ói0k/fÚAQ@br Ɨax&JDŬF.)Tׄ~.9(մa‘v.V<,l`>?jD(IPH ɽ+fu ^0wu߆ܪ6 00 _(;Tc3' z)҃Rde)ȭtQ1FYBI.=N2JA괒wS {׼ x@>+TWBNFfJ[eUm= =tVq[xwwn(WW2[㍳WU6Ȍson,}:^5ڮo?"nc_ pq<@bp;<+A M bDSPW}Q*b)?/8tNPwmlqh_Qj5|W!K0 FMuЭZj5nCPAN-Mini-Inject-1.012/t/local/mymodules/App-runscript-v1.0.0_02.tgz0000644000076500000240000000556314773404621023332 0ustar brianstaffJf][stE_ؼPH kMۊiJ6xXAŒNw @L>Ybٳg/>F~FW5Uhjͦ["j  FYf z]H&80 >`;9YBEwN~`j4Կдƴ[:Ck74R]bܒ/Xb&tg7 LJN. 0?rFz&1Lgφ7_f%Tz@ 2VDpW?g6>>{H-~IsGDOd^+ ?mޑ!VcEl^VȐBEF >M6Gϟ=- `s-?% Jr6/]\.MDOd^@ ec^︫Oȃi5]gzSk7kkx lll(0Ì:YCI46"bO|NMIJHَW#^Q ꒯mǡ0Qqi6hrZt c۱>2!;{CA+;C~agOT9xCXMy1 Ngۈ 'aQ{^ ԦZ3=ͩcIEt'#k6<5B}IcP 671=W@oS#pmw$ys6TVSFԥQk0<u TP bᩩzSӘۤnEi(Y@8Tޔ6x5&=U]ᅧbCNCG'WL(pJqZfA #ڮЎYLV*CpWZM?T>$֔\0?|:5}u3# ^lz)"x:.!}dGxޤ ՜v4#ʔ*UD B Cc`D@ >.3C=6%HC4gXW]kh[ko B-E\-K@ţ￾}˗_T^:}^@ D |@ !/_?0&XWo_x\U7qV[Boi_.O@ "y_?q/.}i"狫1ql&-qH xx(a6Ft{הx㝲{/zG}bQ1 P.%v:KM"קq>۳8{`{g(RV;b;[~/_C8&?8ұz95Uqw;7MJ9#)>j:gJR ҄k+&33$t P0DqȓD4TgYg;yMsrA#;hI'E9-k֩P^W&rBS`L75l[OP!u6!Ƃajnuwx/`dIeoo|#c .W-7LG^ǽd@7crZxs+Kmqk&kMϿi_V)t';q +w31fS'3 bX!+Ѓ1Y= 1"_u֡:%Jڡ9 )UOcہ!t;vM]=чa׌^`a3obZ HVz58p"*ѡ0#:a!Cg +Z^01"6xx1|QQpo`E:d<6?\d9Èe<%϶e,/ u |Xp88aL&^S]6$^WmںHuљOntS."O9aG>3fr2)ĵQZ rCPAN-Mini-Inject-1.012/t/lib/0000755000076500000240000000000014773404622014342 5ustar brianstaffCPAN-Mini-Inject-1.012/t/lib/Local/0000755000076500000240000000000014773404622015374 5ustar brianstaffCPAN-Mini-Inject-1.012/t/lib/Local/localserver.pm0000644000076500000240000000306714773404621020260 0ustar brianstaffuse Test::More; BEGIN { my @needs = grep { ! eval "require $_; 1" } qw(HTTP::Daemon Net::EmptyPort); if( @needs ) { plan 'skip_all' => "Local::localversion needs " . join ' and ', @needs; } } use File::Spec::Functions qw(catfile); use HTTP::Response; use Net::EmptyPort; sub start_server { my( $port ) = @_; my $child_pid = fork; return $child_pid unless $child_pid == 0; require HTTP::Daemon; require HTTP::Date; require HTTP::Status; my $d = HTTP::Daemon->new( LocalPort => $port ) or exit; CONNECTION: while (my $c = $d->accept) { REQUEST: while (my $r = $c->get_request) { my $file = (split m|/|, $r->uri->path)[-1] // 'index.html'; my $path = catfile 't', 'html', $file; if ($r->method eq 'GET') { if( -e $path ) { $c->send_file_response( catfile 't', 'html', $file); } elsif( $path eq 'shutdown' ) { $c->close; undef $c; last CONNECTION; } else { $c->send_error(HTTP::Status::RC_NOT_FOUND()) } } elsif ($r->method eq 'HEAD') { # update_mirror does this if( -e $path ) { my $res = HTTP::Response->new; $res->code(200); $res->content(''); $res->header('Last-Modified' => HTTP::Date::time2str( (stat $path)[9] )), $res->header('Content-Length' => (-s $path)); $c->send_response($res); } else { $c->send_error(HTTP::Status::RC_NOT_FOUND()) } } else { $c->send_error(HTTP::Status::RC_FORBIDDEN()) } } $c->close; undef($c); } exit; } sub can_fetch { require LWP::UserAgent; LWP::UserAgent->new->get( shift )->is_success } 1; CPAN-Mini-Inject-1.012/t/lib/Local/utils.pm0000644000076500000240000000161614773404621017075 0ustar brianstaffuse strict; use warnings; use Carp (); use Data::Dumper; sub global_config_exists { return scalar grep { -r } qw(/usr/local/etc/mcpani /etc/mcpani); } sub has_modes { $^O !~ /^MSWin|^cygwin/ } sub mode { (stat $_[0])[2] & 07777; } sub write_config { my %defaults = qw( local t/local/CPAN remote http://localhost:11027 repository: t/local/MYCPAN dirmode 0775 passive yes ); my %args = (%defaults, @_); my $fh; unless( defined $args{file} ) { ( $fh, $args{file} ) = File::Temp::tempfile(); } unless( defined $fh ) { open $fh, '>', $args{file} or do { Carp::carp "Could not open <$args{file}>: $!"; return; }; } my $contents = <<"HERE"; local: $args{local} remote: $args{remote} repository: $args{repository} dirmode: $args{dirmode} passive: $args{passive} HERE print {$fh} $contents; close $fh; return $args{file}; } 1; CPAN-Mini-Inject-1.012/t/add-multiple.t0000644000076500000240000001321614773404621016344 0ustar brianstaffuse strict; use warnings; use Test::More; use CPAN::Mini::Inject; use File::Basename qw(basename); use File::Copy qw(copy); use File::Path qw(make_path); use File::Spec::Functions qw(catfile); use File::Temp (); use lib qw(t/lib); use Local::utils; my $class = 'CPAN::Mini::Inject'; $SIG{'INT'} = sub { print "\nCleaning up before exiting\n"; exit 1 }; my $temp_dir = File::Temp::tempdir(CLEANUP=>1); subtest 'sanity' => sub { use_ok $class or BAIL_OUT( "Could not load $class: $@" ); isa_ok $class->new, $class; }; subtest 'setup directories in temp dir' => sub { my @dirs = ( [ qw(modules) ], [ qw(authors) ], [ qw(injects) ], ); foreach my $dir ( @dirs ) { my $path = catfile $temp_dir, @$dir; make_path( $path ); ok -d $path, "Path for <@$dir> exists"; } }; my $t_local = catfile qw(t local); subtest 'check local dir' => sub { ok -d $t_local, 'local directory exists'; }; subtest 'copy initial files' => sub { my $modules_base = catfile $temp_dir, 'modules'; ok -d $modules_base, 'modules dir exists'; my $authors_base = catfile $temp_dir, 'authors'; ok -d $authors_base, 'authors dir exists'; subtest 'packages' => sub { my $file = '02packages.details.txt.gz'; my $destination = catfile $modules_base, $file; my $rc = copy( catfile( $t_local, 'CPAN', 'modules', "$file.original" ), $destination ); ok $rc, 'File::Copy worked'; ok -e $destination, 'Copied packages file to temp_dir'; ok chmod(0666, $destination), 'chmod packages to 0666'; }; subtest 'mailrc' => sub { my $file = '01mailrc.txt.gz'; my $destination = catfile $authors_base, $file; my $rc = copy( catfile( $t_local, "$file.original" ), $destination ); ok $rc, 'File::Copy worked'; ok -e $destination, 'Copied mailrc file to temp_dir'; ok chmod(0666, $destination), 'chmod mailrc to 0666'; }; }; sub get_module_details { my( $dist_sources ) = @_; my @modules = ( { module => 'CPAN::Mini::Inject', authorid => 'SSORICHE', version => '0.01', file => catfile( $dist_sources, 'CPAN-Mini-Inject-0.01.tar.gz' ), }, { authorid => 'RWSTAUNER', file => catfile( $dist_sources, 'Dist-Metadata-Test-MetaFile-2.2.tar.gz' ), }, { module => 'Dist::Metadata::Test::MetaFile', authorid => 'RWSTAUNER', version => '2.3', # package versions do not match this file => 't/local/mymodules/Dist-Metadata-Test-MetaFile-2.2.tar.gz' }, { authorid => 'RWSTAUNER', file => 't/local/mymodules/Dist-Metadata-Test-MetaFile-Only.tar.gz' }, { authorid => 'BRIANDFOY', file => 't/local/mymodules/App-runscript-v1.0.0_02.tgz', }, ); } subtest 'add modules' => sub { my $dist_sources = catfile $t_local, 'mymodules'; ok -d $dist_sources, 'Dist sources directory exists'; my @modules = get_module_details( $dist_sources ); subtest 'check module sources are there' => sub { foreach my $module ( @modules ) { ok -e $module->{file}, "$module->{file} exists"; } }; my $tmp_config_file; subtest 'make config' => sub { $tmp_config_file = write_config( local => $temp_dir, repository => catfile( $temp_dir, 'injects' ), ); ok -e $tmp_config_file, 'configuration file exists'; }; my $mcpi = $class->new; isa_ok $mcpi, $class; $mcpi->loadcfg( $tmp_config_file )->parsecfg; foreach my $module ( @modules ) { my $basename = basename($module->{file}); subtest $basename => sub { ok $mcpi->add( %$module ), "Added " . $basename; my $auth_path = catfile( substr($module->{authorid}, 0, 1), substr($module->{authorid}, 0, 2), $module->{authorid}, ); is( $mcpi->{authdir}, $auth_path, "author directory <$auth_path> exists in injects repo" ); my $module_path = catfile $temp_dir, 'injects', 'authors', 'id', $auth_path, $basename; ok( -e $module_path, "Added module <$basename> exists" ); ok( -r $module_path, "Added module <$basename> is readable" ); }; } is_deeply( [$mcpi->added_modules], [ { file => 'CPAN-Mini-Inject-0.01.tar.gz', authorid => 'SSORICHE', modules => {'CPAN::Mini::Inject' => '0.01'} }, { file => 'Dist-Metadata-Test-MetaFile-2.2.tar.gz', authorid => 'RWSTAUNER', modules => { 'Dist::Metadata::Test::MetaFile::PM' => '2.0', 'Dist::Metadata::Test::MetaFile' => '2.1' } }, # added twice (bug in usage not in reporting) { file => 'Dist-Metadata-Test-MetaFile-2.2.tar.gz', authorid => 'RWSTAUNER', modules => { 'Dist::Metadata::Test::MetaFile::PM' => '2.0', 'Dist::Metadata::Test::MetaFile' => '2.1' } }, { file => 'Dist-Metadata-Test-MetaFile-Only.tar.gz', authorid => 'RWSTAUNER', modules => {'Dist::Metadata::Test::MetaFile::DiffName' => '0.02'} }, { file => 'App-runscript-v1.0.0_02.tgz', authorid => 'BRIANDFOY', modules => {'App::runscript' => 'v1.0.0_02'} }, ], 'added_modules returns expected data' ); subtest 'packages entries' => sub { my @expected_lines = ; chomp(@expected_lines); my %expected_lines = map { $_, 1 } grep { /\S/ } @expected_lines; my %Seen; foreach my $line ( @{ $mcpi->{modulelist} } ) { my( $module ) = $line =~ /\A(\S+)/; ok exists $expected_lines{$line}, "Found line for $module"; fail( "Saw $module multiple times" ) if exists $Seen{$module}; $Seen{$module}++; } }; }; done_testing(); __END__ CPAN::Mini::Inject 0.01 S/SS/SSORICHE/CPAN-Mini-Inject-0.01.tar.gz Dist::Metadata::Test::MetaFile::PM 2.0 R/RW/RWSTAUNER/Dist-Metadata-Test-MetaFile-2.2.tar.gz Dist::Metadata::Test::MetaFile 2.1 R/RW/RWSTAUNER/Dist-Metadata-Test-MetaFile-2.2.tar.gz Dist::Metadata::Test::MetaFile::DiffName 0.02 R/RW/RWSTAUNER/Dist-Metadata-Test-MetaFile-Only.tar.gz App::runscript v1.0.0_02 B/BR/BRIANDFOY/App-runscript-v1.0.0_02.tgz CPAN-Mini-Inject-1.012/t/pod-coverage.t0000644000076500000240000000024314773404621016332 0ustar brianstaffuse Test::More; eval "use Test::Pod::Coverage 0.08"; plan skip_all => "Test::Pod::Coverage 0.08 required for testing POD coverage" if $@; all_pod_coverage_ok(); CPAN-Mini-Inject-1.012/t/.mcpani/0000755000076500000240000000000014773404622015121 5ustar brianstaffCPAN-Mini-Inject-1.012/t/.mcpani/config_noread0000644000076500000240000000011714773404621017637 0ustar brianstafflocal: t/local/CPAN remote : http://www.cpan.org repository: t/local/WRITEREPO CPAN-Mini-Inject-1.012/t/.mcpani/config0000644000076500000240000000015214773404621016306 0ustar brianstafflocal: t/local/CPAN remote : http://localhost:11027 repository: t/local/MYCPAN dirmode: 0775 passive: yes CPAN-Mini-Inject-1.012/t/.mcpani/config_mcpi0000644000076500000240000000013514773404621017317 0ustar brianstaffremote: http://www.cpan.org http://localhost local: t/local/CPAN repository: t/read/MYCPAN CPAN-Mini-Inject-1.012/t/.mcpani/config_norepo0000644000076500000240000000006114773404621017667 0ustar brianstafflocal: t/local/CPAN remote : http://www.cpan.org CPAN-Mini-Inject-1.012/t/.mcpani/config_bad0000644000076500000240000000020714773404621017115 0ustar brianstaff# This file is missing a local setting. remote : http://www.cpan.org repository: t/local/MYCPAN passive: yes This line will be ignored CPAN-Mini-Inject-1.012/t/.mcpani/config_nowrite0000644000076500000240000000011214773404621020051 0ustar brianstafflocal: t/read/CPAN remote : http://www.cpan.org repository: t/read/MYCPAN CPAN-Mini-Inject-1.012/t/.mcpani/config_with_whitespaces0000644000076500000240000000034714773404621021746 0ustar brianstaff # all config lines with trailing whitespaces local : t/local/CPAN remote : http://localhost:11027 repository : t/local/MYCPAN dirmode : 0775 passive : yes CPAN-Mini-Inject-1.012/t/.mcpani/config_badremote0000644000076500000240000000017214773404621020332 0ustar brianstafflocal: t/local/CPAN remote : http://blahblah http://localhost:11027 repository: t/local/MYCPAN dirmode: 0775 passive: yes CPAN-Mini-Inject-1.012/t/loadcfg.t0000644000076500000240000000403414773404621015360 0ustar brianstaffuse strict; use warnings; use File::Path qw(make_path); use File::Spec::Functions qw(catfile); use File::Temp (); use Test::More; my $class = 'CPAN::Mini::Inject'; $SIG{'INT'} = sub { print "\nCleaning up before exiting\n"; exit 1 }; my $temp_dir = File::Temp::tempdir(CLEANUP=>1); subtest 'sanity' => sub { use_ok $class; can_ok $class, qw(new loadcfg); }; subtest nothing => sub { delete local $ENV{HOME}; delete local $ENV{MCPANI_CONFIG}; my $mcpi = $class->new; isa_ok $mcpi, $class; can_ok $mcpi, qw(loadcfg); my $config_path = catfile $temp_dir, 'nothing-config'; write_config($config_path); ok -e $config_path, 'config path exists'; ok eval { $mcpi->loadcfg( $config_path ); 1 }, 'loadcfg works'; ok exists $mcpi->{cfgfile}, 'cfgfile key exists'; is( $mcpi->{cfgfile}, $config_path ); }; my $mcpani_dir = catfile $temp_dir, '.mcpani'; subtest 'setup .mcpani' => sub { make_path $mcpani_dir; ok -e $mcpani_dir, '.mcpani dir exists'; }; subtest HOME => sub { local $ENV{HOME} = $temp_dir; my $mcpi = $class->new; isa_ok $mcpi, $class; can_ok $mcpi, qw(loadcfg); my $config_path = catfile $mcpani_dir, 'home-config'; write_config($config_path); ok -e $config_path, 'config path exists'; ok eval { $mcpi->loadcfg( $config_path ); 1 }, 'loadcfg works'; ok exists $mcpi->{cfgfile}, 'cfgfile key exists'; is( $mcpi->{cfgfile}, $config_path ); }; subtest MCPANI_CONFIG => sub { local $ENV{MCPANI_CONFIG} = catfile $temp_dir, 'env-config'; my $mcpi = $class->new; isa_ok $mcpi, $class; can_ok $mcpi, qw(loadcfg); my $config_path = $ENV{MCPANI_CONFIG}; write_config($config_path); ok -e $config_path, 'config path exists'; ok eval { $mcpi->loadcfg( $config_path ); 1 }, 'loadcfg works'; ok exists $mcpi->{cfgfile}, 'cfgfile key exists'; is( $mcpi->{cfgfile}, $ENV{MCPANI_CONFIG}, ); }; done_testing(); sub write_config { my( $path ) = @_; open my $fh, '>', $path; print {$fh} <<"HERE"; local: t/local/CPAN remote : http://localhost:11027 repository: t/local/MYCPAN dirmode: 0775 passive: yes HERE close $fh; } CPAN-Mini-Inject-1.012/README.pod0000644000076500000240000001170514773404621014775 0ustar brianstaff=pod =encoding utf8 =for HTML =for HTML =for HTML =for HTML =for HTML Coverage Status =for HTML =for HTML =head1 The CPAN::Mini::Inject module This is the I for the L Perl module. It provides convenience methods to test things about Perl data type instead of their values. You're probably looking at this because you don't know where else to find what you're looking for. Read this once and you might never have to read one again for any Perl module. =head2 Documentation To read about L, look at the embedded documentation in the module itself. Inside the distribution, you can format it with L: % perldoc lib/CPAN/Mini/Inject.pm If you have already installed the module, you can specify the module name instead of the file location: % perldoc CPAN::Mini::Inject You can read the documentation and inspect the meta data at L. The standard module documentation has example uses in the SYNOPSIS section, but you can also look in the I directory (if it's there), or look at the test files in I. =head2 Installation You can install this module with a CPAN client, which will resolve and install the dependencies: % cpan CPAN::Mini::Inject % cpanm CPAN::Mini::Inject You can also install directly from the distribution directory, which will also install the dependencies: % cpan . % cpanm . You could install just this module manually: % perl Makefile.PL % make % make test % make install You probably don't want to do that unless you're fiddling with the module and only want to run the tests without installing anything. =head2 Source location The meta data, such as the source repository and bug tracker, is in I or the I files it creates. You can find that on those CPAN web interfaces, but you can also look at files directly in the source repository: L If you find a problem, file a ticket in the L. There are also backup repositories hosted on other services. These reflect the state of the main repo and exist only for redundancy: =over 4 =item * L =item * L =item * L =back =head2 GitHub Attestations Starting with 1.005, CPAN::Mini::Inject now uses L, which allow you to verify that the archive file you have was made from the official repo. You need a GitHub account and the L. # download the distro file from GitHub, MetaCPAN, or a CPAN mirror $ gh auth login ...follow instructions... $ gh attestation verify CPAN-Mini-Inject-1.005.tar.gz --owner briandfoy =head2 Getting help Although I'm happy to hear from module users in private email, that's the best way for me to forget to do something. Besides the issue trackers, you can find help at L or L, both of which have many competent Perlers who can answer your question, almost in real time. They might not know the particulars of this module, but they can help you diagnose your problem. You might like to read L. =head2 Copyright and License You should have received a I file, but the license is also noted in the module files. About the only thing you can't do is pretend that you wrote code that you didn't. =head2 Good luck! Enjoy, brian d foy, briandfoy@pobox.com =cut CPAN-Mini-Inject-1.012/MANIFEST.SKIP0000644000076500000240000000227714773404621015236 0ustar brianstaff #!start included /usr/local/perls/perl-5.18.1/lib/5.18.1/ExtUtils/MANIFEST.SKIP # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.git\b \B\.gitignore\b \b_darcs\b \B\.cvsignore$ # Avoid VMS specific MakeMaker generated files \bDescrip.MMS$ \bDESCRIP.MMS$ \bdescrip.mms$ # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ \bBuild.bat$ \bBuild.COM$ \bBUILD.COM$ \bbuild.com$ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ \.tmp$ \.# \.rej$ # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ # Avoid Devel::Cover and Devel::CoverX::Covered files. \bcover_db\b \bcovered\b # Avoid MYMETA files ^MYMETA\. #!end included /usr/local/perls/perl-5.18.1/lib/5.18.1/ExtUtils/MANIFEST.SKIP \.?appveyor.yml \.releaserc \.lwpcookies ^CPAN-.* \bMANIFEST\s\d \bChanges\s\d \.icloud$ \A\.github\b \.gitattributes\b t/local/WRITEREPO/modulelist ^t/local/CPAN/authors ^t/local/MYCPAN ^t/local/mymodules/App-runscript-v1.0.0_02/ CPAN-Mini-Inject-1.012/META.yml0000664000076500000240000000225014773404623014604 0ustar brianstaff--- abstract: 'Inject modules into a CPAN::Mini mirror.' author: - 'Shawn Sorichetti ' build_requires: HTTP::Daemon: '0' Net::EmptyPort: '0' Test::More: '1' configure_requires: ExtUtils::MakeMaker: '6.64' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: CPAN-Mini-Inject no_index: directory: - t - inc requires: CPAN::Checksums: '2.13' CPAN::Meta: '2.150010' CPAN::Mini: '0.32' Carp: '0' Compress::Zlib: '0' Dist::Metadata: '0.921' File::Basename: '0' File::Copy: '0' File::Path: '2.07' File::Slurp: '0' File::Spec: '2.07' File::Spec::Functions: '0' File::Temp: '0' Getopt::Long: '0' IO::Zlib: '0' LWP::Simple: '0' Pod::Usage: '0' YAML: '0' perl: '5.016' version: '0.9915' resources: bugtracker: https://github.com/briandfoy/cpan-mini-inject/issues homepage: https://github.com/briandfoy/cpan-mini-inject repository: https://github.com/briandfoy/cpan-mini-inject version: '1.012' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' CPAN-Mini-Inject-1.012/lib/0000755000076500000240000000000014773404622014077 5ustar brianstaffCPAN-Mini-Inject-1.012/lib/CPAN/0000755000076500000240000000000014773404622014620 5ustar brianstaffCPAN-Mini-Inject-1.012/lib/CPAN/Mini/0000755000076500000240000000000014773404622015514 5ustar brianstaffCPAN-Mini-Inject-1.012/lib/CPAN/Mini/Inject/0000755000076500000240000000000014773404622016730 5ustar brianstaffCPAN-Mini-Inject-1.012/lib/CPAN/Mini/Inject/Config.pm0000644000076500000240000001177214773404621020502 0ustar brianstaffuse v5.16; package CPAN::Mini::Inject::Config; use strict; use warnings; our $VERSION = '0.38'; use Carp; use File::Spec::Functions qw(rootdir catfile); =head1 NAME CPAN::Mini::Inject::Config - Config for CPAN::Mini::Inject =head1 SYNOPSIS my $config = CPAN::Mini::Inject::Config->new; =head1 DESCRIPTION =head2 Configuration This is the default class dealing with the default L config. The simplest config is a key-value file: local: t/local/CPAN remote : http://localhost:11027 repository: t/local/MYCPAN dirmode: 0775 passive: yes This module digests that and returns it as a hash reference. Any module that wants to use a different sort of config structure needs to return the same hash: { local => 't/local/CPAN', remote => 'http://localhost:11027', repository => 't/local/MYCPAN', dirmode => '0775', passive => 'yes', } =over 4 =item * dirmode Set the permissions of created directories to the specified mode. The default value is based on umask if supported. =item * force passthrough to L. =item * local (required) location to store local CPAN::Mini mirror =item * log_level passthrough to L =item * module_filters passthrough to L =item * passive Enable passive FTP. =item * remote (required) CPAN site(s) to mirror from. Multiple sites can be listed space separated. =item * repository Location to store modules to add to the local CPAN::Mini mirror. =item * skip_cleanup passthrough to L =item * skip_perl passthrough to L =item * trace passthrough to L =back =head2 Methods =over 4 =item C =cut sub new { bless { file => undef }, $_[0] } =item C<< config_file( [FILE] ) >> =cut sub config_file { my ( $self, $file ) = @_; if ( @_ == 2 ) { croak( "Could not read file [$file]!" ) unless -r $file; $self->{file} = $file; } $self->{file}; } =item C<< load_config() >> loadcfg accepts a L config file or if not defined will search the following four places in order: =over 4 =item * file pointed to by the environment variable C =item * F<$HOME/.mcpani/config> =item * F =item * F =back loadcfg sets the instance variable cfgfile to the file found or undef if none is found. print "$mcpi->{cfgfile}\n"; # /etc/mcpani =cut sub load_config { my $self = shift; my $cfgfile = shift || $self->_find_config; croak "$0: unable to find config file" unless $cfgfile; $self->config_file( $cfgfile ); return $cfgfile; } sub _find_config { my ( @files ) = ( $ENV{MCPANI_CONFIG}, ( defined $ENV{HOME} ? catfile( $ENV{HOME}, qw(.mcpani config) ) : () ), catfile( rootdir(), qw(usr local etc mcpani) ), catfile( rootdir(), qw(etc mcpani) ), ); for my $file ( @files ) { next unless defined $file; next unless -r $file; return $file; } return; } =item C<< parse_config() >> parsecfg reads the config file stored in the instance variable cfgfile and creates a hash in config with each setting. $mcpi->{config}{remote} # CPAN sites to mirror from. parsecfg expects the config file in the following format: local: /www/CPAN remote: http://cpan.metacpan.org/ repository: /work/mymodules passive: yes dirmode: 0755 If either local or remote are not defined parsecfg croaks. =cut sub parse_config { my $self = shift; my $file = shift; my %required = map { $_, 1 } qw(local remote); $self->load_config( $file ) unless $self->config_file; if ( -r $self->config_file ) { open my ( $fh ), "<", $self->config_file or croak sprintf "$0: cannot open config file <%s>: $!", $self->config_file; while ( <$fh> ) { next if /^\s*#/; chomp; if( /^\s*([^:\s]+)\s*:\s*(.*?)\s*$/ ) { $self->{$1} = $2; delete $required{$1} if defined $required{$1}; } else { carp sprintf "$0: %s:%d ignoring invalid configuration line: %s\n", $self->config_file, $., $_; } } close $fh; if( keys %required ) { croak sprintf "$0: missing required parameter(s): %s", join ' ', keys %required; } } return $self; } =item C<< get( DIRECTIVE ) >> Return the value for the named configuration directive. =cut sub get { $_[0]->{ $_[1] } } =item C<< set( DIRECTIVE, VALUE ) >> Sets the value for the named configuration directive. =cut sub set { $_[0]->{ $_[1] } = $_[2] } =back =head1 AUTHOR Shawn Sorichetti C<< >> =head1 SOURCE AVAILABILITY The main repository is on GitHub: https://github.com/briandfoy/cpan-mini-inject There are also backup repositories on several other services: https://bitbucket.org/briandfoy/cpan-mini-inject https://codeberg.org/briandfoy/cpan-mini-inject https://gitlab.com/briandfoy/cpan-mini-inject =head1 COPYRIGHT & LICENSE Copyright 2004 Shawn Sorichetti, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut __PACKAGE__; CPAN-Mini-Inject-1.012/lib/CPAN/Mini/Inject.pm0000644000076500000240000005152314773404621017273 0ustar brianstaffuse v5.16; # from dependencies, so go for it. package CPAN::Mini::Inject; use strict; use warnings; use CPAN::Checksums 2.13; use CPAN::Mini; use CPAN::Mini::Inject::Config; use Carp; use Compress::Zlib; use File::Basename; use File::Copy; use File::Path qw( make_path ); use File::Spec; use File::Spec::Functions; use File::Temp qw(tempfile); use LWP::Simple; use Dist::Metadata (); BEGIN { use version 0.9915; use CPAN::Meta::Converter; # This is here because the CPAN::Meta package has not been updated # since 2016 and it's unlikely that they'd accept a patch for this. # see https://github.com/briandfoy/cpan-mini-inject/issues/11 # and https://github.com/Perl-Toolchain-Gang/CPAN-Meta#138 package # hide from PAUSE CPAN::Meta::Converter; no warnings qw(redefine); # lifted from CPAN::Meta::Converter # https://fastapi.metacpan.org/source/DAGOLDEN/CPAN-Meta-2.150010/lib/CPAN/Meta/Converter.pm sub _clean_version { my ($element) = @_; return 0 if ! defined $element; $element =~ s{^\s*}{}; $element =~ s{\s*$}{}; $element =~ s{^\.}{0.}; return 0 if ! length $element; return 0 if ( $element eq 'undef' || $element eq '' ); my $v = eval { version->parse($element) }; # XXX check defined $v and not just $v because version objects leak memory # in boolean context -- dagolden, 2012-02-03 if ( defined $v ) { return _is_qv($v) ? $v->stringify : $element; } else { return 0; } } } =encoding utf8 =head1 NAME CPAN::Mini::Inject - Inject modules into a CPAN::Mini mirror. =cut our $VERSION = '1.012'; our @ISA = qw( CPAN::Mini ); =head1 SYNOPSIS If you're not going to customize the way CPAN::Mini::Inject works you probably want to look at the L command instead. use CPAN::Mini::Inject; $mcpi=CPAN::Mini::Inject->new; $mcpi->parsecfg('t/.mcpani/config'); $mcpi->add( module => 'CPAN::Mini::Inject', authorid => 'SSORICHE', version => ' 0.01', file => 'mymodules/CPAN-Mini-Inject-0.01.tar.gz' ); $mcpi->writelist; $mcpi->update_mirror; $mcpi->inject; =head1 DESCRIPTION CPAN::Mini::Inject uses CPAN::Mini to build or update a I CPAN mirror from a I one. It adds two extra features: 1. an additional I of distribution files and related information (author and module versions), separate from the local and remote mirrors, to which you can add your own distribution files. 2. the ability to I the distribution files from your I into a I CPAN mirror. =head1 METHODS Each method in CPAN::Mini::Inject returns a CPAN::Mini::Inject object which allows method chaining. For example: my $mcpi=CPAN::Mini::Inject->new; $mcpi->parsecfg ->update_mirror ->inject; A C ISA L. Refer to the L for that module for details of the interface C inherits from it. =over 4 =item C Create a new CPAN::Mini::Inject object. =cut sub new { my( $class, %args ) = @_; my %defaults = ( config_class => $class->default_config_class, ); my %allowed = map { $_, 1 } qw(config_class); my %filtered = map { ($_, $args{$_}) } grep { exists $allowed{$_} } keys %args; my %obj = ( %defaults, %filtered ); return bless \%obj, $class; } =item C<< config_class( [CLASS] ) >> Returns the name of the class used to handle the configuration. Also see C. =cut sub config_class { my $self = shift; if ( @_ ) { $self->{config_class} = shift } $self->{config_class}; } =item C<< config( [HASHREF] ) >> With a hashref argument, sets the config data. Returns the current configuration hash. =cut sub config { my $self = shift; if ( @_ ) { $self->{config} = shift } $self->{config}; } =item C<< default_config_class >> =cut sub default_config_class { 'CPAN::Mini::Inject::Config' } =item C<< loadcfg( [FILENAME] ) >> This is a bridge to CPAN::Mini::Inject::Config's loadconfig. It sets the filename for the configuration, or uses one of the defaults. =cut sub loadcfg { my $self = shift; unless ( $self->{config} ) { $self->{config} = $self->config_class->new; } $self->{cfgfile} = $self->{config}->load_config( @_ ); return $self; } =item C<< parsecfg() >> This is a bridge to CPAN::Mini::Inject::Config's parseconfig. =cut sub parsecfg { my $self = shift; unless ( $self->{config} ) { $self->config( $self->config_class->new ); } $self->config->parse_config( @_ ); return $self; } =item C<< site( [SITE] ) >> With an argument, set the site to use to contact CPAN. Returns the site setting, or, if the site has not be set (or was set to undef), returns the empty string. =cut sub site { no warnings; my $self = shift; if ( @_ ) { $self->{site} = shift } $self->{site} // ''; } =item C Test each site listed in the remote parameter of the config file by performing a get on each site in order for authors/01mailrc.txt.gz. The first site to respond successfully is set as the instance variable site. print "$mcpi->{site}\n"; # ftp://ftp.cpan.org/pub/CPAN C accepts an optional parameter to enable verbose mode. =cut sub testremote { my $self = shift; my $verbose = shift; $self->site( undef ) if $self->site; $ENV{FTP_PASSIVE} = 1 if ( $self->config->get( 'passive' ) ); for my $site ( split( /\s+/, $self->config->get( 'remote' ) ) ) { $site .= '/' unless ( $site =~ m/\/$/ ); print "Testing site: $site\n" if ( $verbose ); if ( get( $site . 'authors/01mailrc.txt.gz' ) ) { $self->site( $site ); print "\n$site selected.\n" if ( $verbose ); last; } } croak "$0: unable to connect to any remote site" unless $self->site; return $self; } =item C This is a subclass of CPAN::Mini. =cut sub update_mirror { my $self = shift; my %options = @_; croak sprintf "$0: local directory <%s> is not writable. Cannot update mirror.", $self->config->get( 'local' ) unless -w $self->config->get('local'); $ENV{FTP_PASSIVE} = 1 if $self->config->get( 'passive' ); $options{local} ||= $self->config->get( 'local' ); $options{trace} ||= 0; $options{skip_perl} ||= $self->config->get( 'perl' ) || 1; $options{skip_cleanup} ||= $self->config->get( 'skip_cleanup' ) || 0; # module_filters, log_level, and force my @extra = grep { defined $self->config->get($_) } qw(module_filters log_level force); $options{$_} = $self->config->get($_) for @extra; $self->testremote( $options{trace} ) unless ( $self->site || $options{remote} ); $options{remote} ||= $self->site; $options{dirmode} ||= oct( $self->config->get( 'dirmode' ) || sprintf( '0%o', 0777 & ~umask ) ); CPAN::Mini->update_mirror( %options ); } =item C Add a new distribution to the repository. The C method copies the distribution file into the repository with the same structure as a CPAN site. For example, F with author C is copied to F. add creates the required directory structure below the repository. Packages found in the distribution will be added to the module list For example both C and C will be added to the F file in the repository. Packages will be looked for in the C key of the META file if present, otherwise the files in the dist will be searched. See L for more information. =over 4 =item * module (optional) The package name of the module to add. The distribution file will be searched for modules but you can specify the main one explicitly. =item * authorid (required) The CPAN ID of the module's author. Since this isn't actually CPAN, the ID does not need to exist on CPAN. Typically, this ID uses C<[A-Z]> and is three to ten letters. This is not enforced, but other CPAN tools may not like other sorts of names. =item * version (optional) The module's version number. If you don't specify this. C will try to extract it from the distribution. =item * file (required) The path to the distribution file. =back $mcpani->add( module => 'Module::Name', authorid => 'SOMEAUTHOR', version => 0.01, file => './Module-Name-0.01.tar.gz' ); =cut sub add { my $self = shift; my %options = @_; my $optionchk = _optionchk( \%options, qw/authorid file/ ); croak "$0: required option not specified: $optionchk" if $optionchk; croak "$0: no repository configured" unless $self->config->get( 'repository' ); croak sprintf "$0: cannot write to repository <%s>", $self->config->get( 'repository' ) unless -w $self->config->get( 'repository' ); croak "$0: cannot read module file: $options{file}" unless -r $options{file}; # attempt to guess module and version my $distmeta = Dist::Metadata->new( file => $options{file} ); my $packages = $distmeta->package_versions; # include passed in module and version (prefer the declared version) if ( $options{module} and $options{version} ) { $packages->{ $options{module} } ||= $options{version}; } # if no packages were found we need explicit options if ( !keys %$packages ) { $optionchk = _optionchk( \%options, qw/module version/ ); croak "$0: required option not specified and no modules were found: $optionchk" if $optionchk; } my $modulefile = basename( $options{file} ); $self->readlist unless exists( $self->{modulelist} ); $options{authorid} = uc( $options{authorid} ); $self->{authdir} = $self->_authordir( $options{authorid}, $self->config->get( 'repository' ) ); my $target = $self->config->get( 'repository' ) . '/authors/id/' . $self->{authdir} . '/' . basename( $options{file} ); copy( $options{file}, dirname( $target ) ) or croak "$0: copy failed while adding disribution from <%s> to <%s>: $!", $options{file}, dirname( $target ); $self->_updperms( $target ); { my $mods = join('|', keys %$packages); # remove old versions from the list @{ $self->{modulelist} } = grep { $_ !~ m/\A($mods)\s+/ } @{ $self->{modulelist} }; } # make data available afterwards (since method returns $self) push @{ $self->{added_modules} ||= [] }, { file => $modulefile, authorid => $options{authorid}, modules => $packages }; push( @{ $self->{modulelist} }, map { _fmtmodule( $_, File::Spec::Unix->catfile( File::Spec->splitdir( $self->{authdir} ), $modulefile ), defined($packages->{$_}) ? $packages->{$_} : 'undef' ) } keys %$packages ); return $self; } =item C Returns a list of hash references describing the modules added by this instance. Each hashref will contain C, C, and C. The C entry is a hashref of module names and versions included in the C. The list is cumulative. There will be one entry for each time L was called. This functionality is mostly provided for the included L script to be able to verbosely print all the modules added. =cut sub added_modules { my $self = shift; return @{ $self->{added_modules} ||= [] }; } =item C Insert modules from the repository into the local CPAN::Mini mirror. inject copies each module into the appropriate directory in the CPAN::Mini mirror and updates the CHECKSUMS file. Passing a value to C enables verbose mode, which lists each module as it's injected. =cut sub inject { my $self = shift; my $verbose = shift; my $dirmode = oct( $self->config->get( 'dirmode' ) ) if ( $self->config->get( 'dirmode' ) ); $self->readlist unless ( exists( $self->{modulelist} ) ); my %updatedir; my %already_injected; my %report; for my $modline ( @{ $self->{modulelist} } ) { my ( $module, $version, $file ) = split( /\s+/, $modline ); my $target = $self->config->get( 'local' ) . '/authors/id/' . $file; # collect all modules of a target/file # needed for report push @{ $report{$target} }, $module; next if $already_injected{$module}++; my $source = $self->config->get( 'repository' ) . '/authors/id/' . $file; $updatedir{ dirname( $file ) } = 1; my $tdir = dirname $target; _make_path( $tdir, defined $dirmode ? { mode => $dirmode } : {} ); copy( $source, $tdir ) or croak sprintf "$0: copy failed while injecting <%s> to <%s>: $!", $source, $tdir; $self->_updperms( $target ); } # if verbose report target file and the modules it contains if ( $verbose ) { for my $target (keys %report) { my $target_str = "$target ... injected modules : "; my $fmt = '%' . length($target_str) . "s%s\n"; my @modules = @{ $report{$target} }; printf $fmt, $target_str, shift @modules; # first line with target for my $module ( @modules ) { # rest only the module printf $fmt, '', $module; } } } for my $dir ( keys( %updatedir ) ) { my $root = catfile( $self->config->get( 'local' ), qw(authors id) ); my $authdir = catfile( $root, $dir ); CPAN::Checksums::updatedir( $authdir, $root ); $self->_updperms( catfile($authdir, 'CHECKSUMS') ); } $self->updpackages; $self->updauthors; return $self; } =item C Update the CPAN::Mini mirror's modules/02packages.details.txt.gz with the injected module information. =cut sub updpackages { my $self = shift; my @modules = sort( @{ $self->{modulelist} } ); my $infile = $self->_readpkgs; my %packages; # These need to be unique-per-package, with ones that come from the input # file being overridden. for my $line (@$infile, @modules) { my ($pkg) = split(/\s+/, $line, 2); $packages{$pkg} = $line; }; $self->_writepkgs( [ sort { lc $a cmp lc $b } values %packages ] ); } =item C Update the CPAN::Mini mirror's authors/01mailrc.txt.gz with stub information should the author not actually exist on CPAN =cut sub updauthors { my $self = shift; my $repo_authors = $self->_readauthors; my %author_ids_in_repo = map { my ( $id ) = $_ =~ /alias \s+ (\S+)/xms; $id => 1; } @$repo_authors; my @authors; my %authors_added; AUTHOR: for my $modline ( @{ $self->{modulelist} } ) { my ( $module, $version, $file ) = split( /\s+/, $modline ); my $author = (File::Spec->splitdir( $file ))[2]; next AUTHOR if defined $author_ids_in_repo{$author}; next AUTHOR if defined $authors_added{$author}; push @$repo_authors, sprintf( 'alias %-10s "Custom Non-CPAN author "', $author ); $authors_added{$author} = 1; } $self->_writeauthors( $repo_authors ); } =item C Load the repository's modulelist. =cut sub _repo_file { File::Spec->catfile( shift->config->get( 'repository' ), @_ ); } sub _modulelist { shift->_repo_file( 'modulelist' ) } sub readlist { my $self = shift; $self->{modulelist} = undef; my $ml = $self->_modulelist; return $self unless -e $ml; open MODLIST, '<', $ml or croak "$0: cannot read module list: $ml ($!)"; while ( ) { chomp; push @{ $self->{modulelist} }, $_; } close MODLIST; return $self; } =item C Write to the repository modulelist. =cut sub writelist { my $self = shift; my $modulelist_file = $self->_repo_file( 'modulelist' ); croak "$0: repository dir <%s> is not writable", $self->config->get( 'repository' ) unless -w $self->config->get( 'repository' ); croak "$0: modulelist file <%s> is not writable", $modulelist_file if( -e $modulelist_file and ! -w _ ); return $self unless defined $self->{modulelist}; open my $fh, '>', $modulelist_file or croak sprintf "$0: modulelist file <%s> cannot be opened for writing: %s", $modulelist_file, $!; for ( sort( @{ $self->{modulelist} } ) ) { chomp; print {$fh} "$_\n"; } close $fh; $self->_updperms( $modulelist_file ); return $self; } sub _updperms { my ( $self, $file ) = @_; chmod oct( $self->config->get( 'dirmode' ) ) & 06666, $file if $self->config->get( 'dirmode' ); } sub _optionchk { my ( $options, @list ) = @_; my @missing; for my $option ( @list ) { push @missing, $option unless defined $$options{$option}; } return join ' ', @missing; } sub _make_path { my $um = umask 0; make_path( @_ ); umask $um; } sub _authordir { my ( $self, $author, $dir ) = @_; my @author = ( substr( $author, 0, 1 ), substr( $author, 0, 2 ), $author ); my $dm = $self->config->get( 'dirmode' ); my @new = _make_path( File::Spec->catdir( $dir, 'authors', 'id', @author ), defined $dm ? { mode => oct $dm } : {} ); return return File::Spec->catdir( @author ); } sub _fmtmodule { my ( $module, $file, $version ) = @_; my $fw = 38 - length $version; $fw = length $module if $fw < length $module; return sprintf "%-${fw}s %s %s", $module, $version, $file; } sub _cfg { $_[0]->{config}{ $_[1] } } sub _readpkgs { my $self = shift; my $file = catfile( $self->config->get( 'local' ), 'modules', _packages_file() ); unless( -e $file ) { carp sprintf "$0: <%s> does not exist; starting with empty list of packages\n", $file; return []; } my $gzread = gzopen( $file, 'rb' ) or do { carp sprintf "$0: cannot open <%s>: <%s>; starting with empty list of packages\n", $file, $gzerrno; return [] }; my $inheader = 1; my @packages; my $package; while ( $gzread->gzreadline( $package ) ) { if ( $inheader ) { $inheader = 0 unless $package =~ /\S/; next; } chomp( $package ); push( @packages, $package ); } $gzread->gzclose; return \@packages; } sub _packages_file { '02packages.details.txt.gz' } sub _writepkgs { my( $self, $pkgs ) = @_; my $dir = catfile( $self->config->get('local'), 'modules' ); my $created = () = make_path $dir; unless( -d $dir ) { croak sprintf "$0: directory <%s> does not exist. Cannot continue", $dir; } my($fh, $temp_filename) = tempfile(); my $gzwrite = gzopen($fh, 'wb') or croak sprintf "$0: cannot open local temp file to create <%s>: $gzerrno", _packages_file(); my $unzipped_file = _packages_file() =~ s/\.gz\z//r; my @headers = ( [ 'File' => $unzipped_file ], [ 'URL' => 'http://www.perl.com/CPAN/modules/' . $unzipped_file ], [ 'Description' => 'Package names found in directory $CPAN/authors/id/' ], [ 'Columns' => 'package name, version, path' ], [ 'Intended-For' => 'Automated fetch routines, namespace documentation.' ], [ 'Written-By' => "CPAN::Mini::Inject $VERSION" ], [ 'Line-Count' => scalar( @$pkgs ) ], [ 'Last-Updated' => _fmtdate() ], ); foreach my $header ( @headers ) { $gzwrite->gzwrite(sprintf "%-13s %s\n", $header->[0] . ':', $header->[1]); } $gzwrite->gzwrite("\n"); $gzwrite->gzwrite( "$_\n" ) for ( @$pkgs ); $gzwrite->gzclose; my $dest = catfile( $dir, _packages_file() ); copy( $temp_filename, $dest ) or croak "$0: copying $dest failed: $!"; } sub _readauthors { my $self = shift; my $dir = catfile( $self->config->get('local'), 'authors' ); my $created = () = make_path $dir; unless( -d $dir ) { croak sprintf "$0: directory <%s> does not exist. Cannot continue", $dir; } my $mailrc_file = catfile( $dir, '01mailrc.txt.gz' ); unless( -e $mailrc_file ) { return []; } my $gzread = gzopen( $mailrc_file, 'rb' ) or do { carp sprintf "$0: cannot open <%s>: <%s>\n", $mailrc_file, $gzerrno; return [] }; my @authors; my $author; while ( $gzread->gzreadline( $author ) ) { chomp( $author ); push( @authors, $author ); } $gzread->gzclose; return \@authors; } sub _writeauthors { my $self = shift; my $authors = shift; my $file = catfile( $self->config->get( 'local' ), 'authors', '01mailrc.txt.gz' ); my $gzwrite = gzopen( $file, 'wb' ) or croak sprintf "$0: cannot open local <%s> authors/01mailrc.txt.gz for writing: %s", $file, "$gzerrno"; $gzwrite->gzwrite( "$_\n" ) for ( sort @$authors ); $gzwrite->gzclose; } sub _fmtdate { my @date = split( /\s+/, scalar( gmtime ) ); return "$date[0], $date[2] $date[1] $date[4] $date[3] GMT"; } =back =head1 SEE ALSO L =head1 Original Author Shawn Sorichetti, C<< >> =head1 ACKNOWLEDGEMENTS Special thanks to David Bartle, for bringing this module up to date, and resolving the reported bugs. Thanks to Jozef Kutej for numerous patches. =head1 BUGS Report issues to the GitHub queue at https://github.com/briandfoy/cpan-mini-inject/issues =head1 COPYRIGHT AND LICENSE Copyright 2008-2009 Shawn Sorichetti, Andy Armstrong, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of CPAN::Mini::Inject CPAN-Mini-Inject-1.012/Makefile.PL0000644000076500000240000000670414773404621015311 0ustar brianstaffpackage CPAN::Mini::Inject; use strict; use warnings; =encoding utf8 =head1 The build file for CPAN::Mini::Inject This build file is a modulino; it works as both a build script and a module. To build the distribution, run this file normally: % perl Makefile.PL But, it's more interesting than that. You can load it with C and call C to get the data structure it passes to C: my $package = require '/path/to/Makefile.PL'; my $arguments = $package->arguments; Note that C-ing a file makes an entry in C<%INC> for exactly that name. If you try to C another file with the same name, even from a different path, C thinks it has already loaded the file. As such, I recommend you always require the full path to the file. The return value of the C is a package name (in this case, the name of the main module. Use that to call the C method. Even if this distribution needs a higher version of Perl, this bit only needs v5.8. You can play with the data structure with a primitive Perl. =cut use File::Spec::Functions qw(catfile); my $module = __PACKAGE__; ( my $dist = $module ) =~ s/::/-/g; my $github = 'https://github.com/briandfoy/cpan-mini-inject'; my $main_file = catfile( 'lib', split /::/, "$module.pm" ); my %WriteMakefile = ( 'MIN_PERL_VERSION' => '5.016', # from CPAN::Checksums 'NAME' => $module, 'ABSTRACT_FROM' => $main_file, 'VERSION_FROM' => $main_file, 'LICENSE' => 'perl', 'AUTHOR' => 'Shawn Sorichetti ', 'CONFIGURE_REQUIRES' => { 'ExtUtils::MakeMaker' => '6.64', }, 'BUILD_REQUIRES' => { }, 'TEST_REQUIRES' => { 'HTTP::Daemon' => '0', 'Net::EmptyPort' => '0', 'Test::More' => '1', }, 'PREREQ_PM' => { 'Carp' => '0', 'Compress::Zlib' => '0', 'CPAN::Checksums' => '2.13', 'CPAN::Meta' => '2.150010', 'CPAN::Mini' => '0.32', 'Dist::Metadata' => '0.921', 'File::Basename' => '0', 'File::Copy' => '0', 'File::Path' => '2.07', 'File::Slurp' => '0', 'File::Spec::Functions' => '0', 'File::Spec' => '2.07', 'File::Temp' => '0', 'Getopt::Long' => '0', 'IO::Zlib' => '0', 'LWP::Simple' => '0', 'Pod::Usage' => '0', 'YAML' => '0', 'version' => '0.9915', # see briandfoy/cpan-mini-inject#11 }, 'EXE_FILES' => [qw(bin/mcpani)], 'META_MERGE' => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => $github, web => $github, }, bugtracker => { web => "$github/issues", }, homepage => $github, }, }, clean => { FILES => "$dist-*" }, ); sub arguments { \%WriteMakefile } do_it() unless caller; sub do_it { require File::Spec; my $MM ='ExtUtils::MakeMaker'; my $MM_version = eval{ "$MM " . $WriteMakefile{'CONFIGURE_REQUIRES'}{'ExtUtils::MakeMaker'} } || "$MM 6.64"; eval "use $MM_version; 1" or die "Could not load $MM_version: $@"; eval "use Test::Manifest 1.21" if -e File::Spec->catfile( qw(t test_manifest) ); my $arguments = arguments(); my $minimum_perl = $arguments->{MIN_PERL_VERSION} || '5.008'; eval "require $minimum_perl;" or die $@; WriteMakefile( %$arguments ); } no warnings; __PACKAGE__; CPAN-Mini-Inject-1.012/SECURITY.md0000644000076500000240000000223214773404621015120 0ustar brianstaff# Security Policy for CPAN::Mini::Inject ## Reporting security issues **Do not report security problems on public forums or in repository issues.** Privately report vulnerabilities to the maintainers listed at the end of this document. Include as many details as possible to reproduce the issue, including code samples or test cases. Check that your report does not expose any of your sensitive data, such as passwords, tokens, or other secrets. You do not need to have a solution or fix. Depending on the issue, CPANSec may be notified. You can also privately report issues to the CPAN Security Group (CPANSec) . This is especially important if you think a vulnerability is being actively exploited. CPANSec may report the issue to the relevant authorities. See [Report a Security Issue](https://security.metacpan.org/docs/report.html). ## Response to reports The maintainers aim to respond to all reports within one day, but this may be affected by life and other things that happen to people who maintain open source code. A new release will be provided as soon as possible. ## Maintainers * brian d foy, CPAN-Mini-Inject-1.012/META.json0000664000076500000240000000406314773404623014760 0ustar brianstaff{ "abstract" : "Inject modules into a CPAN::Mini mirror.", "author" : [ "Shawn Sorichetti " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "CPAN-Mini-Inject", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : {} }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.64" } }, "runtime" : { "requires" : { "CPAN::Checksums" : "2.13", "CPAN::Meta" : "2.150010", "CPAN::Mini" : "0.32", "Carp" : "0", "Compress::Zlib" : "0", "Dist::Metadata" : "0.921", "File::Basename" : "0", "File::Copy" : "0", "File::Path" : "2.07", "File::Slurp" : "0", "File::Spec" : "2.07", "File::Spec::Functions" : "0", "File::Temp" : "0", "Getopt::Long" : "0", "IO::Zlib" : "0", "LWP::Simple" : "0", "Pod::Usage" : "0", "YAML" : "0", "perl" : "5.016", "version" : "0.9915" } }, "test" : { "requires" : { "HTTP::Daemon" : "0", "Net::EmptyPort" : "0", "Test::More" : "1" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/briandfoy/cpan-mini-inject/issues" }, "homepage" : "https://github.com/briandfoy/cpan-mini-inject", "repository" : { "type" : "git", "url" : "https://github.com/briandfoy/cpan-mini-inject", "web" : "https://github.com/briandfoy/cpan-mini-inject" } }, "version" : "1.012", "x_serialization_backend" : "JSON::PP version 4.16" }