From 74e30d582ac01d80a7f1b28af247d0a5ee913d55 Mon Sep 17 00:00:00 2001 From: Lorry Tar Creator Date: Tue, 30 Jul 2013 13:39:34 +0000 Subject: CPAN-Mini-Inject-0.33 --- Build.PL | 51 ++ Changes | 144 ++++ MANIFEST | 52 ++ META.json | 76 +++ META.yml | 53 ++ README | 6 + bin/mcpani | 312 +++++++++ inc/MyBuilder.pm | 88 +++ lib/CPAN/Mini/Inject.pm | 747 +++++++++++++++++++++ lib/CPAN/Mini/Inject/Config.pm | 206 ++++++ t/.mcpani/config | 5 + t/.mcpani/config_bad | 5 + t/.mcpani/config_badremote | 5 + t/.mcpani/config_mcpi | 3 + t/.mcpani/config_noread | 3 + t/.mcpani/config_norepo | 2 + t/.mcpani/config_nowrite | 3 + t/.mcpani/config_with_whitespaces | 6 + t/00.load.t | 19 + t/add-multiple.t | 72 ++ t/add.t | 55 ++ t/html/01mailrc.txt.gz | Bin 0 -> 49 bytes t/html/02packages.details.txt.gz | Bin 0 -> 356 bytes t/html/03modlist.data.gz | Bin 0 -> 53 bytes t/html/CHECKSUMS | 1 + t/html/CPAN-Mini-2.1828.tar.gz | 1 + t/html/CPAN-Mini-Inject-1.01.tar.gz | 1 + t/html/index.html | 5 + t/inject.t | 128 ++++ t/lib/CPANServer.pm | 46 ++ t/lib/filenames.pl | 46 ++ t/loadcfg.t | 40 ++ t/local/01mailrc.txt.gz.original | Bin 0 -> 166 bytes .../modules/02packages.details.txt.gz.original | Bin 0 -> 429 bytes t/local/mymodules/CPAN-Mini-0.17.tar.gz | 0 t/local/mymodules/CPAN-Mini-Inject-0.01.tar.gz | 0 .../Dist-Metadata-Test-MetaFile-2.2.tar.gz | Bin 0 -> 878 bytes .../Dist-Metadata-Test-MetaFile-Only.tar.gz | Bin 0 -> 513 bytes t/local/mymodules/not-discoverable.tar.gz | 0 t/new.t | 6 + t/parsecfg.t | 25 + t/pod-coverage.t | 6 + t/pod.t | 4 + t/private.t | 34 + t/read/MYCPAN/modulelist | 3 + t/read/MYCPAN/test-0.01.tar.gz | 0 t/read/authors/01mailrc.txt.gz | 1 + t/readlist.t | 35 + t/testremote.t | 44 ++ t/update_mirror.t | 63 ++ t/writelist.t | 32 + t/zz.exceptions.t | 172 +++++ 52 files changed, 2606 insertions(+) create mode 100644 Build.PL create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 META.json create mode 100644 META.yml create mode 100644 README create mode 100644 bin/mcpani create mode 100644 inc/MyBuilder.pm create mode 100644 lib/CPAN/Mini/Inject.pm create mode 100644 lib/CPAN/Mini/Inject/Config.pm create mode 100644 t/.mcpani/config create mode 100644 t/.mcpani/config_bad create mode 100644 t/.mcpani/config_badremote create mode 100644 t/.mcpani/config_mcpi create mode 100644 t/.mcpani/config_noread create mode 100644 t/.mcpani/config_norepo create mode 100644 t/.mcpani/config_nowrite create mode 100644 t/.mcpani/config_with_whitespaces create mode 100644 t/00.load.t create mode 100644 t/add-multiple.t create mode 100644 t/add.t create mode 100644 t/html/01mailrc.txt.gz create mode 100644 t/html/02packages.details.txt.gz create mode 100644 t/html/03modlist.data.gz create mode 100644 t/html/CHECKSUMS create mode 100644 t/html/CPAN-Mini-2.1828.tar.gz create mode 100644 t/html/CPAN-Mini-Inject-1.01.tar.gz create mode 100644 t/html/index.html create mode 100644 t/inject.t create mode 100644 t/lib/CPANServer.pm create mode 100644 t/lib/filenames.pl create mode 100644 t/loadcfg.t create mode 100644 t/local/01mailrc.txt.gz.original create mode 100644 t/local/CPAN/modules/02packages.details.txt.gz.original create mode 100644 t/local/mymodules/CPAN-Mini-0.17.tar.gz create mode 100644 t/local/mymodules/CPAN-Mini-Inject-0.01.tar.gz create mode 100644 t/local/mymodules/Dist-Metadata-Test-MetaFile-2.2.tar.gz create mode 100644 t/local/mymodules/Dist-Metadata-Test-MetaFile-Only.tar.gz create mode 100644 t/local/mymodules/not-discoverable.tar.gz create mode 100644 t/new.t create mode 100644 t/parsecfg.t create mode 100644 t/pod-coverage.t create mode 100644 t/pod.t create mode 100644 t/private.t create mode 100644 t/read/MYCPAN/modulelist create mode 100644 t/read/MYCPAN/test-0.01.tar.gz create mode 100644 t/read/authors/01mailrc.txt.gz create mode 100644 t/readlist.t create mode 100644 t/testremote.t create mode 100644 t/update_mirror.t create mode 100644 t/writelist.t create mode 100644 t/zz.exceptions.t diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..11d0503 --- /dev/null +++ b/Build.PL @@ -0,0 +1,51 @@ +use strict; +use warnings; +use Module::Build; +use 5.005; + +use lib 'inc'; + +use MyBuilder; + +my $builder = MyBuilder->new( + module_name => 'CPAN::Mini::Inject', + license => 'perl', + dist_author => [ + 'Shawn Sorichetti ', + 'Andy Armstrong ', + 'Christian Walde ', + 'Randy Stauner ', + 'Karen Etheridge ', + 'Salve J. Nilsen ', + 'Wolfgang Pecho ', + ], + dist_version_from => 'lib/CPAN/Mini/Inject.pm', + configure_requires => { 'Module::Build' => 0.4 }, + requires => { + 'CPAN::Checksums' => 0, + 'CPAN::Mini' => '0.32', + 'Carp' => 0, + 'Compress::Zlib' => 0, + 'Dist::Metadata' => '0.921', + 'Env' => 0, + 'File::Basename' => 0, + 'File::Copy' => 0, + 'File::Path' => '2.07', + 'File::Spec' => '2.07', + 'File::Spec::Functions' => 0, + 'Getopt::Long' => 0, + 'HTTP::Server::Simple' => '0.07', + 'IO::Zlib' => 0, + 'LWP::Simple' => 0, + 'Pod::Usage' => 0, + 'Test::More' => 0, + 'YAML' => 0, + 'File::Slurp' => 0, + 'File::Temp' => 0, + }, + add_to_cleanup => + [ 'CPAN-Mini-Inject-*', 't/local/WRITEREPO', 't/local/MYCPAN' ], + script_files => ["bin/mcpani"], +); + +$builder->create_build_script(); diff --git a/Changes b/Changes new file mode 100644 index 0000000..8a660b0 --- /dev/null +++ b/Changes @@ -0,0 +1,144 @@ +Revision history for CPAN-Mini-Inject + +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. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..9eb22d9 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,52 @@ +bin/mcpani +Build.PL +Changes +inc/MyBuilder.pm +lib/CPAN/Mini/Inject.pm +lib/CPAN/Mini/Inject/Config.pm +MANIFEST +META.json +META.yml +README +t/.mcpani/config +t/.mcpani/config_with_whitespaces +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/00.load.t +t/add-multiple.t +t/add.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/CPANServer.pm +t/lib/filenames.pl +t/loadcfg.t +t/local/01mailrc.txt.gz.original +t/local/CPAN/modules/02packages.details.txt.gz.original +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/read/authors/01mailrc.txt.gz +t/read/MYCPAN/modulelist +t/read/MYCPAN/test-0.01.tar.gz +t/readlist.t +t/testremote.t +t/update_mirror.t +t/writelist.t +t/zz.exceptions.t diff --git a/META.json b/META.json new file mode 100644 index 0000000..ccc077e --- /dev/null +++ b/META.json @@ -0,0 +1,76 @@ +{ + "abstract" : "Inject modules into a CPAN::Mini mirror.", + "author" : [ + "Shawn Sorichetti ", + "Andy Armstrong ", + "Christian Walde ", + "Randy Stauner ", + "Karen Etheridge ", + "Salve J. Nilsen ", + "Wolfgang Pecho " + ], + "dynamic_config" : 1, + "generated_by" : "Module::Build version 0.4007, CPAN::Meta::Converter version 2.131560", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "CPAN-Mini-Inject", + "prereqs" : { + "configure" : { + "requires" : { + "Module::Build" : "0.4" + } + }, + "runtime" : { + "requires" : { + "CPAN::Checksums" : "0", + "CPAN::Mini" : "0.32", + "Carp" : "0", + "Compress::Zlib" : "0", + "Dist::Metadata" : "0.921", + "Env" : "0", + "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", + "HTTP::Server::Simple" : "0.07", + "IO::Zlib" : "0", + "LWP::Simple" : "0", + "Pod::Usage" : "0", + "Test::More" : "0", + "YAML" : "0" + } + } + }, + "provides" : { + "CPAN::Mini::Inject" : { + "file" : "lib/CPAN/Mini/Inject.pm", + "version" : "0.33" + }, + "CPAN::Mini::Inject::Config" : { + "file" : "lib/CPAN/Mini/Inject/Config.pm", + "version" : "0.33" + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=CPAN-Mini-Inject" + }, + "license" : [ + "http://dev.perl.org/licenses/" + ], + "repository" : { + "url" : "git://github.com/AndyA/CPAN--Mini--Inject.git" + } + }, + "version" : "0.33" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..41399bf --- /dev/null +++ b/META.yml @@ -0,0 +1,53 @@ +--- +abstract: Inject modules into a CPAN::Mini mirror. +author: +- Shawn Sorichetti +- Andy Armstrong +- Christian Walde +- Randy Stauner +- Karen Etheridge +- Salve J. Nilsen +- Wolfgang Pecho +build_requires: {} +configure_requires: + Module::Build: '0.4' +dynamic_config: 1 +generated_by: Module::Build version 0.4007, CPAN::Meta::Converter version 2.131560 +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 +name: CPAN-Mini-Inject +provides: + CPAN::Mini::Inject: + file: lib/CPAN/Mini/Inject.pm + version: '0.33' + CPAN::Mini::Inject::Config: + file: lib/CPAN/Mini/Inject/Config.pm + version: '0.33' +requires: + CPAN::Checksums: '0' + CPAN::Mini: '0.32' + Carp: '0' + Compress::Zlib: '0' + Dist::Metadata: '0.921' + Env: '0' + 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' + HTTP::Server::Simple: '0.07' + IO::Zlib: '0' + LWP::Simple: '0' + Pod::Usage: '0' + Test::More: '0' + YAML: '0' +resources: + bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=CPAN-Mini-Inject + license: http://dev.perl.org/licenses/ + repository: git://github.com/AndyA/CPAN--Mini--Inject.git +version: '0.33' diff --git a/README b/README new file mode 100644 index 0000000..95db155 --- /dev/null +++ b/README @@ -0,0 +1,6 @@ +README for CPAN::Mini::Inject + +CPAN::Mini::Inject uses CPAN::Mini to build or update a local CPAN mirror +then adds modules from your repository to it. Allowing the inclusion +of private modules in a minimal CPAN mirror. This enables the use of +CPAN/CPANPLUS to install them. diff --git a/bin/mcpani b/bin/mcpani new file mode 100644 index 0000000..913971c --- /dev/null +++ b/bin/mcpani @@ -0,0 +1,312 @@ +#!/usr/bin/perl -w + +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.33'; +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; + my %mirroropts; + + $mirroropts{remote} = $options{remote} + if ( defined( $options{remote} ) ); + $mirroropts{local} = $options{local} + if ( defined( $options{local} ) ); + $mirroropts{trace} = $options{verbose} + if ( defined( $options{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 tar.gz file of the 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 COMMAND LINE OPTIONS + +=head2 --add + +Add a module to the repository for later inclusion in the CPAN Mini +mirror. The add command requires the following parameters: + +=over 4 + +=item --module + +This is the name of the module (ie CPAN::Mini::Inject). + +=item --authorid + +A CPAN 'like' author ID for the module. The author ID does not need to +exist on CPAN. + +=item --modversion + +Version number of the module. This must match the version number in the +file name. + +=item --all-in-meta + +=item --discover-packages + +L adds all modules found in the file. +These options remain for backward compatibility and do nothing. + +=item --file + +File name and path of the module. The file name must follow the +standard CPAN naming convention (the resulting file from a +C). + +=back + + Example: + + mcpani --add --module CPAN::Mini::Inject --authorid SSORICHE + --modversion 0.01 --file ./CPAN-Mini-Inject-0.01.tar.gz + + +=head2 --update + +Update your local CPAN Mini mirror from a CPAN site. Once completed +add the modules contained in the repository to it. This is the same +as running C followed by C + +=head2 --mirror + +Update the local CPAN Mini mirror from CPAN. + +=head2 --inject + +Add the repository modules into the CPAN Mini mirror. + +=head2 -l, --local + +A local directory to store the CPAN Mini mirror in. Specifying this +option overrides the value in the config file. + +=head2 -r, --remote + +A CPAN site to create the local CPAN Mini mirror from. + +=head2 -v, --verbose + +Display verbose processing information + +=head2 -V, --version + +Display version information. + +=head1 CONFIGURATION FILE + +F 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 + +Description of options: + +=over 4 + +=item * local + +location to store local CPAN::Mini mirror (*REQUIRED*) + +=item * remote + +CPAN site(s) to mirror from. Multiple sites can be listed, with spaces +between them. (*REQUIRED*) + +=item * repository + +Location to store modules to add to the local CPAN::Mini mirror. + +=item * passive + +Enable passive FTP. + +=item * dirmode + +Set the permissions of created directories to the specified mode +(octal value). The default value is based on the umask (if supported). + +=back + +F 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 + +=head1 CURRENT MAINTAINER + +Christian Walde C<< >> + +=head1 AUTHOR + +Shawn Sorichetti C<< >> + +=head1 BUGS + +Please report any bugs or feature requests to +C, or through the web interface at +L. I will be notified, and then you'll automatically +be notified of progress on your bug as I make changes. + +=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 diff --git a/inc/MyBuilder.pm b/inc/MyBuilder.pm new file mode 100644 index 0000000..301ce34 --- /dev/null +++ b/inc/MyBuilder.pm @@ -0,0 +1,88 @@ +package MyBuilder; + +use base qw( Module::Build ); + +sub create_build_script { + my ( $self, @args ) = @_; + $self->_auto_mm; + return $self->SUPER::create_build_script( @args ); +} + +sub _auto_mm { + my $self = shift; + my $mm = $self->meta_merge; + my @meta = qw( homepage bugtracker MailingList repository ); + for my $meta ( @meta ) { + next if exists $mm->{resources}{$meta}; + my $auto = "_auto_$meta"; + next unless $self->can( $auto ); + my $av = $self->$auto(); + $mm->{resources}{$meta} = $av if defined $av; + } + $self->meta_merge( $mm ); +} + +sub _auto_repository { + my $self = shift; + if ( -d '.svn' ) { + my $info = `svn info .`; + return $1 if $info =~ /^URL:\s+(.+)$/m; + } + elsif ( -d '.git' ) { + my $info = `git remote -v`; + return unless $info =~ /^origin\s+(.+)\s\(\w+\)$/m; + my $url = $1; + # Special case: patch up github URLs + $url =~ s!^git\@github\.com:!git://github.com/!; + return $url; + } + return; +} + +sub _auto_bugtracker { + 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=' . shift->dist_name; +} + +sub ACTION_testauthor { + my $self = shift; + $self->test_files( 'xt/author' ); + $self->ACTION_test; +} + +sub ACTION_critic { + exec qw( perlcritic -1 -q -profile perlcriticrc lib/ ), glob 't/*.t'; +} + +sub ACTION_tags { + exec( + qw( + ctags -f tags --recurse --totals + --exclude=blib + --exclude=.svn + --exclude='*~' + --languages=Perl + t/ lib/ + ) + ); +} + +sub ACTION_tidy { + my $self = shift; + + my @extra = qw( Build.PL ); + + my %found_files = map { %$_ } $self->find_pm_files, + $self->_find_file_by_type( 'pm', 't' ), + $self->_find_file_by_type( 'pm', 'inc' ), + $self->_find_file_by_type( 't', 't' ); + + my @files = ( keys %found_files, + map { $self->localize_file_path( $_ ) } @extra ); + + for my $file ( @files ) { + system 'perltidy', '-b', $file; + unlink "$file.bak" if $? == 0; + } +} + +1; diff --git a/lib/CPAN/Mini/Inject.pm b/lib/CPAN/Mini/Inject.pm new file mode 100644 index 0000000..6dd59cd --- /dev/null +++ b/lib/CPAN/Mini/Inject.pm @@ -0,0 +1,747 @@ +package CPAN::Mini::Inject; + +use strict; +use warnings; + +use CPAN::Checksums qw( updatedir ); +use CPAN::Mini; +use CPAN::Mini::Inject::Config; +use Carp; +use Compress::Zlib; +use Env; +use File::Basename; +use File::Copy; +use File::Path qw( make_path ); +use File::Spec; +use LWP::Simple; +use Dist::Metadata (); + +=head1 NAME + +CPAN::Mini::Inject - Inject modules into a CPAN::Mini mirror. + +=head1 VERSION + +Version 0.33 + +=cut + +our $VERSION = '0.33'; +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 local CPAN mirror +then adds modules from your repository to it, allowing the inclusion +of private modules in a minimal 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. + +=head2 C + +Create a new CPAN::Mini::Inject object. + +=cut + +sub new { + return bless + { config_class => 'CPAN::Mini::Inject::Config' }, + $_[0]; +} + +=head2 C<< config_class( [CLASS] ) >> + +Returns the name of the class handling the configuration. + +With an argument, it sets the name of the class to handle +the config. To use that, you'll have to call it before you +load the configuration. + +=cut + +sub config_class { + my $self = shift; + + if ( @_ ) { $self->{config_class} = shift } + + $self->{config_class}; +} + +=head2 C<< config >> + +Returns the configuration object. This object should be from +the class returned by C unless you've done something +weird. + +=cut + +sub config { + my $self = shift; + + if ( @_ ) { $self->{config} = shift } + + $self->{config}; +} + +=head2 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; +} + +=head2 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; +} + +=head2 C<< site( [SITE] ) >> + +Returns the CPAN site that CPAN::Mini::Inject chose from the +list specified in the C directive. + +=cut + +sub site { + no warnings; + my $self = shift; + + if ( @_ ) { $self->{site} = shift } + + $self->{site} || ''; +} + +=head2 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 "Unable to connect to any remote site" unless $self->site; + + return $self; +} + +=head2 C + +This is a subclass of CPAN::Mini. + +=cut + +sub update_mirror { + my $self = shift; + my %options = @_; + + croak 'Can not write to local: ' . $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; + + $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 ); +} + +=head2 C + +Add a new module to the repository. The add method copies the module +file into the repository with the same structure as a CPAN site. For +example CPAN-Mini-Inject-0.01.tar.gz is copied to +MYCPAN/authors/id/S/SS/SSORICHE. 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). + +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 + +The name of the module to add. +The distribution file will be searched for modules +but you can specify the main one explicitly. + +=item * authorid + +CPAN author id. This does not have to be a real author id. + +=item * version + +The modules version number. +Module names and versions will be determined, +but you can specify one explicitly. + +=item * file + +The tar.gz of the module. + +=back + +=head3 Example + + add( module => 'Module::Name', + authorid => 'AUTHOR', + 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 "Required option not specified: $optionchk" if $optionchk; + croak "No repository configured" + unless ( $self->config->get( 'repository' ) ); + croak "Can not write to repository: " + . $self->config->get( 'repository' ) + unless ( -w $self->config->get( 'repository' ) ); + + croak "Can not 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 discovered version) + if ( $options{module} ) { + $packages->{ $options{module} } ||= $options{version}; + } + + # if no packages were found we need explicit options + if ( !keys %$packages ) { + $optionchk + = _optionchk( \%options, qw/module version/ ); + + croak "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 "Copy failed: $!"; + + $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; +} + +=head2 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} ||= [] }; +} + +=head2 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; + for my $modline ( @{ $self->{modulelist} } ) { + my ( $module, $version, $file ) = split( /\s+/, $modline ); + + next if $already_injected{$file}++; + + my $target = $self->config->get( 'local' ) . '/authors/id/' . $file; + 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 "Copy $source to $tdir failed: $!"; + + $self->_updperms( $target ); + print "$target ... injected $module\n" if $verbose; + } + + for my $dir ( keys( %updatedir ) ) { + my $authdir = $self->config->get( 'local' ) . "/authors/id/$dir"; + + updatedir( $authdir ); + $self->_updperms( "$authdir/CHECKSUMS" ); + } + + $self->updpackages; + $self->updauthors; + + return $self; +} + +=head2 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 values %packages ] ); +} + +=head2 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 ); + + # extract the author from the path + my @dirs = File::Spec->splitdir( $file ); + my $author = $dirs[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 ); + +} + +=head2 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 "Can not read module list: $ml ($!)"; + while ( ) { + chomp; + push @{ $self->{modulelist} }, $_; + } + close MODLIST; + + return $self; +} + +=head2 C + +Write to the repository modulelist. + +=cut + +sub writelist { + my $self = shift; + + croak 'Can not write module list: ' + . $self->config->get( 'repository' ) + . "/modulelist ERROR: $!" + unless ( -w $self->{config}{repository} . '/modulelist' + || -w $self->{config}{repository} ); + return $self unless defined( $self->{modulelist} ); + + open( MODLIST, + '>' . $self->config->get( 'repository' ) . '/modulelist' ); + for ( sort( @{ $self->{modulelist} } ) ) { + chomp; + print MODLIST "$_\n"; + } + close( MODLIST ); + + $self->_updperms( + $self->config->get( 'repository' ) . '/modulelist' ); + + 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 $gzread = gzopen( + $self->config->get( 'local' ) + . '/modules/02packages.details.txt.gz', 'rb' + ) or croak "Cannot open local 02packages.details.txt.gz: $gzerrno"; + + 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 _writepkgs { + my $self = shift; + my $pkgs = shift; + + my $gzwrite = gzopen( + $self->config->get( 'local' ) + . '/modules/02packages.details.txt.gz', 'wb' + ) + or croak + "Can't open local 02packages.details.txt.gz for writing: $gzerrno"; + + $gzwrite->gzwrite( "File: 02packages.details.txt\n" ); + $gzwrite->gzwrite( + "URL: http://www.perl.com/CPAN/modules/02packages.details.txt\n" + ); + $gzwrite->gzwrite( + 'Description: Package names found in directory $CPAN/authors/id/' + . "\n" ); + $gzwrite->gzwrite( "Columns: package name, version, path\n" ); + $gzwrite->gzwrite( + "Intended-For: Automated fetch routines, namespace documentation.\n" + ); + $gzwrite->gzwrite( "Written-By: CPAN::Mini::Inject $VERSION\n" ); + $gzwrite->gzwrite( "Line-Count: " . scalar( @$pkgs ) . "\n" ); + # Last-Updated: Sat, 19 Mar 2005 19:49:10 GMT + $gzwrite->gzwrite( "Last-Updated: " . _fmtdate() . "\n\n" ); + + $gzwrite->gzwrite( "$_\n" ) for ( @$pkgs ); + + $gzwrite->gzclose; + +} + +sub _readauthors { + my $self = shift; + my $gzread + = gzopen( $self->config->get( 'local' ) . '/authors/01mailrc.txt.gz', + 'rb' ) + or croak "Cannot open " + . $self->config->get( 'local' ) + . "/authors/01mailrc.txt.gz: $gzerrno"; + + 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 $gzwrite + = gzopen( $self->config->get( 'local' ) . '/authors/01mailrc.txt.gz', + 'wb' ) + or croak + "Can't open local authors/01mailrc.txt.gz for writing: $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"; +} + +=head1 See Also + +L + +=head1 Current Maintainer + +Christian Walde C<< >> + +=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 + +Please report any bugs or feature requests to +C, or through the web interface at +L. I will be notified, and then you'll automatically +be notified of progress on your bug as I make changes. + +=head1 Copyright & 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 diff --git a/lib/CPAN/Mini/Inject/Config.pm b/lib/CPAN/Mini/Inject/Config.pm new file mode 100644 index 0000000..5e89627 --- /dev/null +++ b/lib/CPAN/Mini/Inject/Config.pm @@ -0,0 +1,206 @@ +package CPAN::Mini::Inject::Config; + +use strict; +use warnings; + +use Carp; +use File::Spec::Functions qw(rootdir catfile); + +=head1 NAME + +CPAN::Mini::Inject::Config - Config for CPAN::Mini::Inject + +=head1 VERSION + +Version 0.33 + +=cut + +our $VERSION = '0.33'; + +=head2 C + +=cut + +sub new { bless { file => undef }, $_[0] } + +=head2 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}; +} + +=head2 C<< load_config() >> + +loadcfg accepts a CPAN::Mini::Inject config file or if not defined +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 + + +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 '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; +} + +=head2 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: ftp://ftp.cpan.org/pub/CPAN ftp://ftp.kernel.org/pub/CPAN + repository: /work/mymodules + passive: yes + dirmode: 0755 + +Description of options: + +=over 4 + +=item * local + +location to store local CPAN::Mini mirror (*REQUIRED*) + +=item * remote + +CPAN site(s) to mirror from. Multiple sites can be listed space separated. +(*REQUIRED*) + +=item * repository + +Location to store modules to add to the local CPAN::Mini mirror. + +=item * passive + +Enable passive FTP. + +=item * dirmode + +Set the permissions of created directories to the specified mode. The default +value is based on umask if supported. + +=back + +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( "Could not open config file: $!" ); + + while ( <$fh> ) { + next if /^\s*#/; + $self->{$1} = $2 if /^\s*([^:\s]+)\s*:\s*(.*?)\s*$/; + delete $required{$1} if defined $required{$1}; + } + + close $fh; + + croak 'Required parameter(s): ' + . join( ' ', keys %required ) + . ' missing.' + if keys %required; + } + + return $self; +} + +=head2 C<< get( DIRECTIVE ) >> + +Return the value for the named configuration directive. + +=cut + +sub get { $_[0]->{ $_[1] } } + +=head2 C<< set( DIRECTIVE, VALUE ) >> + +Sets the value for the named configuration directive. + +=cut + +sub set { $_[0]->{ $_[1] } = $_[2] } + +=head1 CURRENT MAINTAINER + +Christian Walde C<< >> + +=head1 BUGS + +Please report any bugs or feature requests to +C, or through the web interface at +L. I will be notified, and then you'll automatically +be notified of progress on your bug as I make changes. + +=cut + +1; diff --git a/t/.mcpani/config b/t/.mcpani/config new file mode 100644 index 0000000..40403b6 --- /dev/null +++ b/t/.mcpani/config @@ -0,0 +1,5 @@ +local: t/local/CPAN +remote : http://localhost:11027 +repository: t/local/MYCPAN +dirmode: 0775 +passive: yes diff --git a/t/.mcpani/config_bad b/t/.mcpani/config_bad new file mode 100644 index 0000000..9c345d3 --- /dev/null +++ b/t/.mcpani/config_bad @@ -0,0 +1,5 @@ +# This file is missing a local setting. +remote : http://www.cpan.org +repository: t/local/MYCPAN +passive: yes +This line will be ignored diff --git a/t/.mcpani/config_badremote b/t/.mcpani/config_badremote new file mode 100644 index 0000000..8cab746 --- /dev/null +++ b/t/.mcpani/config_badremote @@ -0,0 +1,5 @@ +local: t/local/CPAN +remote : http://blahblah http://localhost:11027 +repository: t/local/MYCPAN +dirmode: 0775 +passive: yes diff --git a/t/.mcpani/config_mcpi b/t/.mcpani/config_mcpi new file mode 100644 index 0000000..b06d530 --- /dev/null +++ b/t/.mcpani/config_mcpi @@ -0,0 +1,3 @@ +remote: http://www.cpan.org http://localhost +local: t/local/CPAN +repository: t/read/MYCPAN diff --git a/t/.mcpani/config_noread b/t/.mcpani/config_noread new file mode 100644 index 0000000..c970925 --- /dev/null +++ b/t/.mcpani/config_noread @@ -0,0 +1,3 @@ +local: t/local/CPAN +remote : http://www.cpan.org +repository: t/local/WRITEREPO diff --git a/t/.mcpani/config_norepo b/t/.mcpani/config_norepo new file mode 100644 index 0000000..dbb8e8a --- /dev/null +++ b/t/.mcpani/config_norepo @@ -0,0 +1,2 @@ +local: t/local/CPAN +remote : http://www.cpan.org diff --git a/t/.mcpani/config_nowrite b/t/.mcpani/config_nowrite new file mode 100644 index 0000000..ffb6f18 --- /dev/null +++ b/t/.mcpani/config_nowrite @@ -0,0 +1,3 @@ +local: t/read/CPAN +remote : http://www.cpan.org +repository: t/read/MYCPAN diff --git a/t/.mcpani/config_with_whitespaces b/t/.mcpani/config_with_whitespaces new file mode 100644 index 0000000..cd86168 --- /dev/null +++ b/t/.mcpani/config_with_whitespaces @@ -0,0 +1,6 @@ + # all config lines with trailing whitespaces + local : t/local/CPAN + remote : http://localhost:11027 + repository : t/local/MYCPAN + dirmode : 0775 + passive : yes diff --git a/t/00.load.t b/t/00.load.t new file mode 100644 index 0000000..35ba62b --- /dev/null +++ b/t/00.load.t @@ -0,0 +1,19 @@ +use Test::More tests => 1; + +BEGIN { + use_ok( 'CPAN::Mini::Inject' ); +} + +diag( "Testing CPAN::Mini::Inject $CPAN::Mini::Inject::VERSION" ); + +# Setup for other tests + +mkdir( 't/local/WRITEREPO' ); +open( WRITEFILE, '>', 't/local/WRITEREPO/modulelist' ); +close( WRITEFILE ); +chmod( 0222, 't/local/WRITEREPO/modulelist' ); + +chmod( 0555, 't/read/MYCPAN' ); +chmod( 0444, 't/read/MYCPAN/modulelist' ); +chmod( 0444, 't/read/MYCPAN/test-0.01.tar.gz' ); + diff --git a/t/add-multiple.t b/t/add-multiple.t new file mode 100644 index 0000000..8aad410 --- /dev/null +++ b/t/add-multiple.t @@ -0,0 +1,72 @@ +use Test::More tests => 13; + +use CPAN::Mini::Inject; +use File::Path; + +mkdir( 't/local/MYCPAN' ); + +my $mcpi; +$mcpi = CPAN::Mini::Inject->new; +$mcpi->loadcfg( 't/.mcpani/config' )->parsecfg; + +$mcpi->add( + module => 'CPAN::Mini::Inject', + authorid => 'SSORICHE', + version => '0.01', + file => 't/local/mymodules/CPAN-Mini-Inject-0.01.tar.gz' + )->add( + #module => 'Dist::Metadata::Test::MetaFile', + authorid => 'RWSTAUNER', + #version => '2.1', + file => 't/local/mymodules/Dist-Metadata-Test-MetaFile-2.2.tar.gz' + )->add( + 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' + )->add( + authorid => 'RWSTAUNER', + file => 't/local/mymodules/Dist-Metadata-Test-MetaFile-Only.tar.gz' + ); + +my $auth_path = File::Spec->catfile( 'R', 'RW', 'RWSTAUNER' ); +is( $mcpi->{authdir}, $auth_path, 'author directory' ); + +foreach $dist ( qw( + t/local/MYCPAN/authors/id/S/SS/SSORICHE/CPAN-Mini-Inject-0.01.tar.gz + t/local/MYCPAN/authors/id/R/RW/RWSTAUNER/Dist-Metadata-Test-MetaFile-2.2.tar.gz + t/local/MYCPAN/authors/id/R/RW/RWSTAUNER/Dist-Metadata-Test-MetaFile-Only.tar.gz +) ) { + ok( -r $dist, "Added module '$dist' is readable" ); +} + +foreach $line ( + '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', +) { + ok( grep( /$line/, @{ $mcpi->{modulelist} } ), 'Module added to list' ) + or diag explain [$line, $mcpi->{modulelist}]; + + my $pack = ($line =~ /^(\S+)/)[0]; + is( grep( /^$pack\s+/, @{ $mcpi->{modulelist} } ), + 1, 'Module added to list just once' ); +} + +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'} }, + ], + 'info for added modules' +); + +rmtree( 't/local/MYCPAN', 0, 1 ); diff --git a/t/add.t b/t/add.t new file mode 100644 index 0000000..1e52bfb --- /dev/null +++ b/t/add.t @@ -0,0 +1,55 @@ +use Test::More tests => 6; + +use CPAN::Mini::Inject; +use File::Path; + +mkdir( 't/local/MYCPAN' ); + +my $mcpi; +$mcpi = CPAN::Mini::Inject->new; +$mcpi->loadcfg( 't/.mcpani/config' )->parsecfg; + +$mcpi->add( + module => 'CPAN::Mini::Inject', + authorid => 'SSORICHE', + version => '0.01', + file => 't/local/mymodules/CPAN-Mini-Inject-0.01.tar.gz' + )->add( + module => 'CPAN::Mini::Inject', + authorid => 'SSORICHE', + version => '0.02', + file => 't/local/mymodules/CPAN-Mini-Inject-0.01.tar.gz' + ); + +my $soriche_path = File::Spec->catfile( 'S', 'SS', 'SSORICHE' ); +is( $mcpi->{authdir}, $soriche_path, 'author directory' ); +ok( + -r 't/local/MYCPAN/authors/id/S/SS/SSORICHE/CPAN-Mini-Inject-0.01.tar.gz', + 'Added module is readable' +); +my $module + = "CPAN::Mini::Inject 0.02 S/SS/SSORICHE/CPAN-Mini-Inject-0.01.tar.gz"; +ok( grep( /$module/, @{ $mcpi->{modulelist} } ), + 'Module added to list' ); +is( grep( /^CPAN::Mini::Inject\s+/, @{ $mcpi->{modulelist} } ), + 1, 'Module added to list just once' ); + +SKIP: { + skip "Not a UNIX system", 2 if ( $^O =~ /^MSWin/ ); + is( ( stat( 't/local/MYCPAN/authors/id/S/SS/SSORICHE' ) )[2] & 07777, + 0775, 'Added author directory mode is 0775' ); + is( + ( + stat( + 't/local/MYCPAN/authors/id/S/SS/SSORICHE/CPAN-Mini-Inject-0.01.tar.gz' + ) + )[2] & 07777, + 0664, + 'Added module mode is 0664' + ); +} + +# XXX do the same test as above again, but this time with a ->readlist after +# the ->parsecfg + +rmtree( 't/local/MYCPAN', 0, 1 ); diff --git a/t/html/01mailrc.txt.gz b/t/html/01mailrc.txt.gz new file mode 100644 index 0000000..7bee62a Binary files /dev/null and b/t/html/01mailrc.txt.gz differ diff --git a/t/html/02packages.details.txt.gz b/t/html/02packages.details.txt.gz new file mode 100644 index 0000000..79ce42c Binary files /dev/null and b/t/html/02packages.details.txt.gz differ diff --git a/t/html/03modlist.data.gz b/t/html/03modlist.data.gz new file mode 100644 index 0000000..689b691 Binary files /dev/null and b/t/html/03modlist.data.gz differ diff --git a/t/html/CHECKSUMS b/t/html/CHECKSUMS new file mode 100644 index 0000000..2a02d41 --- /dev/null +++ b/t/html/CHECKSUMS @@ -0,0 +1 @@ +TEST diff --git a/t/html/CPAN-Mini-2.1828.tar.gz b/t/html/CPAN-Mini-2.1828.tar.gz new file mode 100644 index 0000000..2a02d41 --- /dev/null +++ b/t/html/CPAN-Mini-2.1828.tar.gz @@ -0,0 +1 @@ +TEST diff --git a/t/html/CPAN-Mini-Inject-1.01.tar.gz b/t/html/CPAN-Mini-Inject-1.01.tar.gz new file mode 100644 index 0000000..2a02d41 --- /dev/null +++ b/t/html/CPAN-Mini-Inject-1.01.tar.gz @@ -0,0 +1 @@ +TEST diff --git a/t/html/index.html b/t/html/index.html new file mode 100644 index 0000000..9cbf947 --- /dev/null +++ b/t/html/index.html @@ -0,0 +1,5 @@ + + +

Index

+ + diff --git a/t/inject.t b/t/inject.t new file mode 100644 index 0000000..dfc03a2 --- /dev/null +++ b/t/inject.t @@ -0,0 +1,128 @@ +use Test::More tests => 11; + +use CPAN::Mini::Inject; +use File::Path; +use File::Copy; +use File::Basename; +use Compress::Zlib; + +rmtree( ['t/local/MYCPAN/modulelist'], 0, 1 ); +copy( + 't/local/CPAN/modules/02packages.details.txt.gz.original', + 't/local/CPAN/modules/02packages.details.txt.gz' +); +chmod oct(666), 't/local/CPAN/modules/02packages.details.txt.gz'; +chmod oct(666), "t/local/CPAN/authors/01mailrc.txt.gz" if -f "t/local/CPAN/authors/01mailrc.txt.gz"; +rmtree( ['t/local/CPAN/authors'], 0, 1 ); +mkdir( 't/local/CPAN/authors' ); +copy( + 't/local/01mailrc.txt.gz.original', + 't/local/CPAN/authors/01mailrc.txt.gz' +); +chmod oct(666), 't/local/CPAN/authors/01mailrc.txt.gz'; +mkdir( 't/local/MYCPAN' ); + +my $mcpi; +my $module = "S/SS/SSORICHE/CPAN-Mini-Inject-0.01.tar.gz"; + +$mcpi = CPAN::Mini::Inject->new; + +## add three modules (one that was already there, to make sure it isn't +## duplicated in the output) +$mcpi->loadcfg( 't/.mcpani/config' )->parsecfg->readlist->add( + module => 'CPAN::Mini::Inject', + authorid => 'SSORICHE', + version => '0.01', + file => 't/local/mymodules/CPAN-Mini-Inject-0.01.tar.gz' + )->add( + module => 'CPAN::Mini::Inject', + authorid => 'SSORICHE', + version => '0.02', + file => 't/local/mymodules/CPAN-Mini-Inject-0.01.tar.gz' + )->add( + module => 'CPAN::Mini', + authorid => 'RJBS', + version => '0.17', + file => 't/local/mymodules/CPAN-Mini-0.17.tar.gz', + )->writelist; + +ok( $mcpi->inject, 'Copy modules' ); +ok( -e "t/local/CPAN/authors/id/$module", 'Module file exists' ); +ok( -e 't/local/CPAN/authors/id/S/SS/SSORICHE/CHECKSUMS', + 'Checksum created' ); + +SKIP: { + skip "Not a UNIX system", 3 if ( $^O =~ /^MSWin/ ); + is( ( stat( "t/local/CPAN/authors/id/$module" ) )[2] & 07777, + 0664, 'Module file mode set' ); + is( + ( stat( dirname( "t/local/CPAN/authors/id/$module" ) ) )[2] & 07777, + 0775, + 'Author directory mode set' + ); + is( + ( stat( 't/local/CPAN/authors/id/S/SS/SSORICHE/CHECKSUMS' ) )[2] + & 07777, + 0664, + 'Checksum file mode set' + ); +} + +my @goodfile = ; +ok( my $gzread + = gzopen( 't/local/CPAN/modules/02packages.details.txt.gz', 'rb' ) ); + +my @packages; +my $package; +while ( $gzread->gzreadline( $package ) ) { + if ( $package =~ /^Written-By:/ ) { + push( @packages, "Written-By:\n" ); + next; + } + if ( $package =~ /^Last-Updated:/ ) { + push( @packages, "Last-Updated:\n" ); + next; + } + push( @packages, $package ); +} +$gzread->gzclose; + +is_deeply( \@goodfile, \@packages ); + +ok( my $gzauthread + = gzopen( 't/local/CPAN/authors/01mailrc.txt.gz', 'rb' ) ); + +my $author; +my $author_was_injected = 0; +while ( $gzauthread->gzreadline( $author ) ) { + if ( $author =~ /SSORICHE/ ) { + $author_was_injected++; + } +} +$gzauthread->gzclose; +ok( $author_was_injected, 'author injected into 01mailrc.txt.gz' ); +ok( $author_was_injected == 1, 'author injected exactly 1 time' ); + +unlink( 't/local/CPAN/authors/id/S/SS/SSORICHE/CHECKSUMS' ); +unlink( "t/local/CPAN/authors/id/$module" ); +unlink( 't/local/MYCPAN/modulelist' ); +unlink( 't/local/CPAN/modules/02packages.details.txt.gz' ); + +rmtree( [ 't/local/CPAN/authors', 't/local/MYCPAN' ], 0, 1 ); + +__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: 6 +Last-Updated: + +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 diff --git a/t/lib/CPANServer.pm b/t/lib/CPANServer.pm new file mode 100644 index 0000000..90a5cc9 --- /dev/null +++ b/t/lib/CPANServer.pm @@ -0,0 +1,46 @@ +package CPANServer; + +use strict; +use warnings; +use base qw(HTTP::Server::Simple::CGI); +use File::Spec::Functions; + +sub handle_request { + my $self = shift; + my $cgi = shift; + + my $file = ( split( '/', $cgi->path_info ) )[-1]; + $file = 'index.html' unless ( $file ); + open( INFILE, catfile( 't', 'html', $file ) ) + or die "Can't open file $file: $@"; + print $_ while ( ); + close( INFILE ); +} + +our %env_mapping = ( + protocol => "SERVER_PROTOCOL", + localport => "SERVER_PORT", + localname => "SERVER_NAME", + path => "PATH_INFO", + request_uri => "REQUEST_URI", + method => "REQUEST_METHOD", + peeraddr => "REMOTE_ADDR", + peername => "REMOTE_HOST", + query_string => "QUERY_STRING", +); + +sub setup { + no warnings 'uninitialized'; + my $self = shift; + + while ( my ( $item, $value ) = splice @_, 0, 2 ) { + if ( $self->can( $item ) ) { + $self->$item( $value ); + } + if ( my $k = $env_mapping{$item} ) { + $ENV{$k} = $value; + } + } +} + +1; diff --git a/t/lib/filenames.pl b/t/lib/filenames.pl new file mode 100644 index 0000000..504b4bf --- /dev/null +++ b/t/lib/filenames.pl @@ -0,0 +1,46 @@ +$WriteRepo = catfile( qw(t local WRITEREPO) ); + +%MYCPAN => ( dir => catfile( qw(t read MYCPAN) ), ); + +my @files = qw(modulelist test-0.01.tar.gz); +$MYCPAN{@files} = map { catfile( $MYCPAN{dir}, $_ ) } @files; + +return 1 if ( -r '/usr/local/etc/mcpani' ); +return 1 if ( -r '/etc/mcpani' ); + +# parsecfg() +dies_ok { $mcpi->parsecfg( catfile( qw(t .mcpani config_bad) ) ); } +'Missing config option'; + +mkdir catfile( qw(t local MYCPAN) ); +$mcpi->parsecfg( catfile( qw(t .mcpani config_noread) ) ); +dies_ok { $mcpi->readlist } 'unreadable file'; + +$mcpi->parsecfg( catfile( qw(t .mcpani config) ) ); + +$mcpi->parsecfg( catfile( qw(t .mcpani config_norepo) ) ); + +dies_ok { + $mcpi->add( + module => 'CPAN::Mini::Inject', + authorid => 'SSORICHE', + version => '0.01', + file => 'test-0.01.tar.gz' + ); +} +'Missing config repository'; + +$mcpi->parsecfg( catfile( qw(t .mcpani config_read) ) ); + +$mcpi->parsecfg( catfile( qw(t .mcpani config_nowrite) ) ); +dies_ok { $mcpi->writelist } 'fail write file'; + +mkdir catfile( qw(t local WRITEREPO) ); +open WRITEFILE, '>', catfile( qw(t local WRITEREPO modulelist) ); +close WRITEFILE; +chmod 0222, catfile( qw(t local WRITEREPO modulelist) ); + +chmod 0555, catfile( qw(t read MYCPAN) ); +chmod 0444, catfile( qw(t read MYCPAN modulelist) ); +chmod 0444, catfile( qw(t read MYCPAN test-0.01.tar.gz) ); + diff --git a/t/loadcfg.t b/t/loadcfg.t new file mode 100644 index 0000000..4e8fcb5 --- /dev/null +++ b/t/loadcfg.t @@ -0,0 +1,40 @@ +use Test::More tests => 3; + +use CPAN::Mini::Inject; +use Env; + +sub chkcfg { + return 1 if ( -r '/usr/local/etc/mcpani' ); + return 1 if ( -r '/etc/mcpani' ); +} + +my $prevhome; +if ( defined( $ENV{HOME} ) ) { + $prevhome = $ENV{HOME}; + delete $ENV{HOME}; +} + +my $mcpanienv; +if ( defined( $ENV{MCPANI_CONFIG} ) ) { + $mcpanienv = $ENV{MCPANI_CONFIG}; + delete $ENV{MCPANI_CONFIG}; +} + +my $native_path = File::Spec->catfile( qw( t .mcpani config ) ); +my $mcpi = CPAN::Mini::Inject->new; + +$mcpi->loadcfg( $native_path ); +is( $mcpi->{cfgfile}, $native_path ); + +$ENV{HOME} = 't'; +$mcpi->loadcfg; +is( $mcpi->{cfgfile}, $native_path ); + +$ENV{MCPANI_CONFIG} = $native_path; +$mcpi->loadcfg; +is( $mcpi->{cfgfile}, $native_path ); + +# XXX add tests for /usr/local/etc/mcpani and /etc/minicpani + +$ENV{MCPANI_CONFIG} = $mcpanienv if ( defined( $mcpanienv ) ); +$ENV{HOME} = $prevhome if ( defined( $prevhome ) ); diff --git a/t/local/01mailrc.txt.gz.original b/t/local/01mailrc.txt.gz.original new file mode 100644 index 0000000..d14acf2 Binary files /dev/null and b/t/local/01mailrc.txt.gz.original differ diff --git a/t/local/CPAN/modules/02packages.details.txt.gz.original b/t/local/CPAN/modules/02packages.details.txt.gz.original new file mode 100644 index 0000000..60cdbd7 Binary files /dev/null and b/t/local/CPAN/modules/02packages.details.txt.gz.original differ diff --git a/t/local/mymodules/CPAN-Mini-0.17.tar.gz b/t/local/mymodules/CPAN-Mini-0.17.tar.gz new file mode 100644 index 0000000..e69de29 diff --git a/t/local/mymodules/CPAN-Mini-Inject-0.01.tar.gz b/t/local/mymodules/CPAN-Mini-Inject-0.01.tar.gz new file mode 100644 index 0000000..e69de29 diff --git a/t/local/mymodules/Dist-Metadata-Test-MetaFile-2.2.tar.gz b/t/local/mymodules/Dist-Metadata-Test-MetaFile-2.2.tar.gz new file mode 100644 index 0000000..3c49465 Binary files /dev/null and b/t/local/mymodules/Dist-Metadata-Test-MetaFile-2.2.tar.gz differ diff --git a/t/local/mymodules/Dist-Metadata-Test-MetaFile-Only.tar.gz b/t/local/mymodules/Dist-Metadata-Test-MetaFile-Only.tar.gz new file mode 100644 index 0000000..4af56c9 Binary files /dev/null and b/t/local/mymodules/Dist-Metadata-Test-MetaFile-Only.tar.gz differ diff --git a/t/local/mymodules/not-discoverable.tar.gz b/t/local/mymodules/not-discoverable.tar.gz new file mode 100644 index 0000000..e69de29 diff --git a/t/new.t b/t/new.t new file mode 100644 index 0000000..bedd1e6 --- /dev/null +++ b/t/new.t @@ -0,0 +1,6 @@ +use Test::More tests => 1; + +use CPAN::Mini::Inject; + +my $mcpi = CPAN::Mini::Inject->new; +isa_ok( $mcpi, 'CPAN::Mini::Inject' ); diff --git a/t/parsecfg.t b/t/parsecfg.t new file mode 100644 index 0000000..bbd0976 --- /dev/null +++ b/t/parsecfg.t @@ -0,0 +1,25 @@ +use Test::More tests => 11; + +use CPAN::Mini::Inject; + +my $mcpi = CPAN::Mini::Inject->new; +$mcpi->loadcfg( 't/.mcpani/config' ); +$mcpi->parsecfg; +is( $mcpi->{config}{local}, 't/local/CPAN' ); +is( $mcpi->{config}{remote}, 'http://localhost:11027' ); +is( $mcpi->{config}{repository}, 't/local/MYCPAN' ); + +$mcpi = CPAN::Mini::Inject->new; +$mcpi->parsecfg( 't/.mcpani/config' ); +is( $mcpi->{config}{local}, 't/local/CPAN' ); +is( $mcpi->{config}{remote}, 'http://localhost:11027' ); +is( $mcpi->{config}{repository}, 't/local/MYCPAN' ); + + +$mcpi = CPAN::Mini::Inject->new; +$mcpi->parsecfg( 't/.mcpani/config_with_whitespaces' ); +is( $mcpi->{config}{local}, 't/local/CPAN' ); +is( $mcpi->{config}{remote}, 'http://localhost:11027' ); +is( $mcpi->{config}{repository}, 't/local/MYCPAN' ); +is( $mcpi->{config}{dirmode}, '0775' ); +is( $mcpi->{config}{passive}, 'yes' ); diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..963cbc9 --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,6 @@ +use 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(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..437887a --- /dev/null +++ b/t/pod.t @@ -0,0 +1,4 @@ +use Test::More; +eval "use Test::Pod 1.00"; +plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; +all_pod_files_ok(); diff --git a/t/private.t b/t/private.t new file mode 100644 index 0000000..f1199ac --- /dev/null +++ b/t/private.t @@ -0,0 +1,34 @@ +#!perl + +use strict; +use warnings; + +use CPAN::Mini::Inject; +use Test::More tests => 2; + +{ + # _fmtmodule + 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'; + } +} + +# vim:ts=2:sw=2:et:ft=perl + diff --git a/t/read/MYCPAN/modulelist b/t/read/MYCPAN/modulelist new file mode 100644 index 0000000..c72f881 --- /dev/null +++ b/t/read/MYCPAN/modulelist @@ -0,0 +1,3 @@ +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 diff --git a/t/read/MYCPAN/test-0.01.tar.gz b/t/read/MYCPAN/test-0.01.tar.gz new file mode 100644 index 0000000..e69de29 diff --git a/t/read/authors/01mailrc.txt.gz b/t/read/authors/01mailrc.txt.gz new file mode 100644 index 0000000..9daeafb --- /dev/null +++ b/t/read/authors/01mailrc.txt.gz @@ -0,0 +1 @@ +test diff --git a/t/readlist.t b/t/readlist.t new file mode 100644 index 0000000..ad4635a --- /dev/null +++ b/t/readlist.t @@ -0,0 +1,35 @@ +use Test::More tests => 2; + +use CPAN::Mini::Inject; +use File::Path; + +rmtree( ['t/local/MYCPAN/modulelist'], 0, 1 ); +mkdir 't/local/MYCPAN'; + +my $mcpi; +$mcpi = CPAN::Mini::Inject->new; +$mcpi->loadcfg( 't/.mcpani/config' )->parsecfg; + +$mcpi->readlist; +is( $mcpi->{modulelist}, undef, 'Empty module list' ); + +genmodlist(); + +$mcpi = CPAN::Mini::Inject->new; +$mcpi->loadcfg( 't/.mcpani/config' )->parsecfg->readlist; + +is( @{ $mcpi->{modulelist} }, 3, 'Read modulelist' ); + +rmtree( ['t/local/MYCPAN/modulelist'], 0, 1 ); + +sub genmodlist { + open( MODLIST, '>t/local/MYCPAN/modulelist' ) + or die "Can not create t/local/MYCPAN/modulelist: $!"; + print MODLIST << "EOF" +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 +EOF + ; + close( MODLIST ); +} diff --git a/t/testremote.t b/t/testremote.t new file mode 100644 index 0000000..900d3e8 --- /dev/null +++ b/t/testremote.t @@ -0,0 +1,44 @@ +use Test::More; + +use LWP; +use CPAN::Mini::Inject; +use lib 't/lib'; + +BEGIN { + eval "use CPANServer"; + + plan skip_all => "HTTP::Server::Simple required to test update_mirror" + if $@; + plan tests => 3; +} + +my $server = CPANServer->new( 11027 ); +my $pid = $server->background; +ok( $pid, 'HTTP Server started' ); +# Give server time to get going. +sleep 1; + +$SIG{__DIE__} = sub { kill( 9, $pid ) }; + +my $mcpi = CPAN::Mini::Inject->new; +$mcpi->loadcfg( 't/.mcpani/config' )->parsecfg; + +$mcpi->testremote; +is( $mcpi->{site}, 'http://localhost:11027/', 'Correct remote URL' ); + +$mcpi->loadcfg( 't/.mcpani/config_badremote' )->parsecfg; + +SKIP: { + skip 'Test fails with funky DNS providers', 1 + if can_fetch( 'http://blahblah' ); + # This fails with OpenDNS &c + $mcpi->testremote; + is( $mcpi->{site}, 'http://localhost:11027/', + 'Selects correct remote URL' ); +} + +kill( 9, $pid ); + +unlink( 't/testconfig' ); + +sub can_fetch { LWP::UserAgent->new->get( shift )->is_success } diff --git a/t/update_mirror.t b/t/update_mirror.t new file mode 100644 index 0000000..c90cea2 --- /dev/null +++ b/t/update_mirror.t @@ -0,0 +1,63 @@ +use Test::More; +use File::Spec::Functions; +use strict; +use warnings; + +use lib 't/lib'; + +BEGIN { + eval "use CPANServer"; + + plan skip_all => "HTTP::Server::Simple required to test update_mirror" + if $@; + plan tests => 8; +} + +use CPAN::Mini::Inject; +use File::Path; + +rmtree( [ catdir( 't', 'mirror' ) ], 0, 1 ); + +my $server = CPANServer->new( 11027 ); +my $pid = $server->background; +ok( $pid, 'HTTP Server started' ); +sleep 1; + +$SIG{__DIE__} = sub { kill( 9, $pid ) }; + +my $mcpi = CPAN::Mini::Inject->new; +$mcpi->parsecfg( 't/.mcpani/config' ); + +mkdir( catdir( 't', 'mirror' ) ); + +$mcpi->update_mirror( + remote => 'http://localhost:11027', + local => catdir( 't', 'mirror' ) +); + +kill( 9, $pid ); + +ok( -e catfile( qw(t mirror authors 01mailrc.txt.gz) ), + 'Mirrored 01mailrc.txt.gz' ); +ok( -e catfile( qw(t mirror modules 02packages.details.txt.gz) ), + 'Mirrored 02packages.details.txt.gz' ); +ok( -e catfile( qw(t mirror modules 03modlist.data.gz) ), + 'Mirrored 03modlist.data.gz' ); + +ok( -e catfile( qw(t mirror authors id R RJ RJBS CHECKSUMS) ), + 'RJBS CHECKSUMS' ); +ok( + -e catfile( + qw(t mirror authors id R RJ RJBS CPAN-Mini-2.1828.tar.gz) ), + 'CPAN::Mini' +); +ok( -e catfile( qw(t mirror authors id S SS SSORICHE CHECKSUMS) ), + 'SSORICHE CHECKSUMS' ); +ok( + -e catfile( + qw(t mirror authors id S SS SSORICHE CPAN-Mini-Inject-1.01.tar.gz) + ), + 'CPAN::Mini::Inject' +); +sleep 1; # allow locks to expire +rmtree( [ catdir( 't', 'mirror' ) ], 0, 1 ); diff --git a/t/writelist.t b/t/writelist.t new file mode 100644 index 0000000..de9d907 --- /dev/null +++ b/t/writelist.t @@ -0,0 +1,32 @@ +use Test::More tests => 2; + +use CPAN::Mini::Inject; + +my $mcpi; +my $module + = "CPAN::Mini::Inject 0.01 S/SS/SSORICHE/CPAN-Mini-Inject-0.01.tar.gz"; + +unlink( 't/local/MYCPAN/modulelist' ); + +genmodlist(); + +$mcpi = CPAN::Mini::Inject->new; +$mcpi->loadcfg( 't/.mcpani/config' )->parsecfg->readlist; + +push( @{ $mcpi->{modulelist} }, $module ); +is( @{ $mcpi->{modulelist} }, 4, 'Updated memory modulelist' ); +ok( $mcpi->writelist, 'Write modulelist' ); + +unlink( 't/local/MYCPAN/modulelist' ); + +sub genmodlist { + open( MODLIST, '>t/local/MYCPAN/modulelist' ) + or die "Can not create t/local/MYCPAN/modulelist: $!"; + print MODLIST << "EOF" +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 +EOF + ; + close( MODLIST ); +} diff --git a/t/zz.exceptions.t b/t/zz.exceptions.t new file mode 100644 index 0000000..f90c9de --- /dev/null +++ b/t/zz.exceptions.t @@ -0,0 +1,172 @@ +use Test::More; + +BEGIN { + eval "use Test::Exception"; + + plan skip_all => "Test Exceptions required to test croaks" if $@; + plan tests => 12; +} + +use CPAN::Mini::Inject; +use File::Path; +use Env; +use lib 't/lib'; + +sub chkcfg { + return 1 if ( -r '/usr/local/etc/mcpani' ); + return 1 if ( -r '/etc/mcpani' ); +} + +my $prevhome; +if ( defined( $ENV{HOME} ) ) { + $prevhome = $ENV{HOME}; + delete $ENV{HOME}; +} + +my $mcpanienv; +if ( defined( $ENV{MCPANI_CONFIG} ) ) { + $mcpanienv = $ENV{MCPANI_CONFIG}; + delete $ENV{MCPANI_CONFIG}; +} + +# loadcfg() +SKIP: { + skip 'Config file exists', 1 if chkcfg(); + my $mcpi = CPAN::Mini::Inject->new; + dies_ok { $mcpi->loadcfg } 'No config file'; +} + +{ + # parsecfg() + my $mcpi = CPAN::Mini::Inject->new; + dies_ok { $mcpi->parsecfg( 't/.mcpani/config_bad' ); } + 'Missing config option'; +} + +# readlist() +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 $mcpi = CPAN::Mini::Inject->new; + + rmtree( ['t/local/MYCPAN/modulelist'], 0, 1 ); + mkdir 't/local/MYCPAN'; + $mcpi->parsecfg( 't/.mcpani/config_noread' ); + dies_ok { $mcpi->readlist } 'unreadable file'; + rmtree( ['t/local/MYCPAN/modulelist'], 0, 1 ); +} + +{ + my $mcpi = CPAN::Mini::Inject->new; + $mcpi->parsecfg( 't/.mcpani/config' ); + + # add() + dies_ok { + $mcpi->add( + module => 'CPAN::Mini::Inject', + authorid => 'SSORICHE', + version => '0.01' + ); + } + 'Missing add param'; + + dies_ok { + $mcpi->add( + module => 'CPAN::Mini::Inject', + authorid => 'SSORICHE', + version => '0.01', + file => 'blahblah' + ); + } + 'Module file not readable'; + + lives_ok { + $mcpi->add( + authorid => 'RWSTAUNER', + file => 't/local/mymodules/Dist-Metadata-Test-MetaFile-Only.tar.gz' + ); + } + 'Ok without module/version when discoverable'; + + 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'; + + dies_ok { + $mcpi->add( + authorid => 'RWSTAUNER', + file => 't/local/mymodules/not-discoverable.tar.gz' + ); + } + 'Dies without module/version when not discoverable'; +} + +{ + my $mcpi = CPAN::Mini::Inject->new; + $mcpi->parsecfg( 't/.mcpani/config_norepo' ); + + dies_ok { + $mcpi->add( + module => 'CPAN::Mini::Inject', + authorid => 'SSORICHE', + version => '0.01', + file => 'test-0.01.tar.gz' + ); + } + 'Missing config repository'; + +} + +SKIP: { + skip "We don't have a r/o repo", 2; + my $mcpi = CPAN::Mini::Inject->new; + $mcpi->parsecfg( 't/.mcpani/config_read' ); + + dies_ok { + $mcpi->add( + module => 'CPAN::Mini::Inject', + authorid => 'SSORICHE', + version => '0.01', + file => 'test-0.01.tar.gz' + ); + } + 'read-only repository'; + + $mcpi->{config}{remote} = "ftp://blahblah http://blah blah"; + dies_ok { $mcpi->testremote } 'No reachable site'; + +} + +# writelist() +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 $mcpi = CPAN::Mini::Inject->new; + rmtree( ['t/local/MYCPAN/modulelist'], 0, 1 ); + mkdir 't/local/MYCPAN'; + $mcpi->parsecfg( 't/.mcpani/config_nowrite' ); + dies_ok { $mcpi->writelist } 'fail write file'; + rmtree( ['t/local/MYCPAN/modulelist'], 0, 1 ); +} + +# Setup routines +sub genmodlist { + open( MODLIST, '>t/local/MYCPAN/modulelist' ) + or die "Can not create t/local/MYCPAN/modulelist: $!"; + print MODLIST << "EOF" +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 +EOF + ; + close( MODLIST ); +} + -- cgit v1.2.1