r32835 - in /trunk/libcpan-mini-perl: Changes LICENSE MANIFEST META.yml Makefile.PL README bin/minicpan debian/changelog debian/control inc/ lib/CPAN/Mini.pm lib/CPAN/Mini/ t/00-load.t t/00_load.t t/pod-coverage.t t/pod.t xt/
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Thu Apr 9 00:16:50 UTC 2009
Author: ryan52-guest
Date: Thu Apr 9 00:16:45 2009
New Revision: 32835
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=32835
Log:
* New upstream release
* Debian Policy 3.8.1
Added:
trunk/libcpan-mini-perl/LICENSE
- copied unchanged from r32834, branches/upstream/libcpan-mini-perl/current/LICENSE
trunk/libcpan-mini-perl/inc/
- copied from r32834, branches/upstream/libcpan-mini-perl/current/inc/
trunk/libcpan-mini-perl/lib/CPAN/Mini/
- copied from r32834, branches/upstream/libcpan-mini-perl/current/lib/CPAN/Mini/
trunk/libcpan-mini-perl/t/00-load.t
- copied unchanged from r32834, branches/upstream/libcpan-mini-perl/current/t/00-load.t
trunk/libcpan-mini-perl/xt/
- copied from r32834, branches/upstream/libcpan-mini-perl/current/xt/
Removed:
trunk/libcpan-mini-perl/t/00_load.t
trunk/libcpan-mini-perl/t/pod-coverage.t
trunk/libcpan-mini-perl/t/pod.t
Modified:
trunk/libcpan-mini-perl/Changes
trunk/libcpan-mini-perl/MANIFEST
trunk/libcpan-mini-perl/META.yml
trunk/libcpan-mini-perl/Makefile.PL
trunk/libcpan-mini-perl/README
trunk/libcpan-mini-perl/bin/minicpan
trunk/libcpan-mini-perl/debian/changelog
trunk/libcpan-mini-perl/debian/control
trunk/libcpan-mini-perl/lib/CPAN/Mini.pm
Modified: trunk/libcpan-mini-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcpan-mini-perl/Changes?rev=32835&op=diff
==============================================================================
--- trunk/libcpan-mini-perl/Changes (original)
+++ trunk/libcpan-mini-perl/Changes Thu Apr 9 00:16:45 2009
@@ -1,62 +1,137 @@
-0.550 2006-08-08
- add tilde expansion for homedir in local mirror specification
- move configuration reading into CPAN::Mini
- document a few previously-undocumented things
- documentation cleanup
- added unused-by-script option to use current mtime for indices
- (this helps CPANPLUS do the right thing)
+Revision history for CPAN-Mini
-0.500 2006-07-11
- we no longer need File::HomeDir::Win32 on Windows
- provide the also_mirror option to get other static files
+0.576 2009-01-16
+ add repo to metadata
-0.40 2005-11-04
- remove force option to trace
- create local mirror if needed
- notice if local mirror -e && ! -d
- cleared out stupid /\A\s+\z/ lines
+0.575 2009-01-12
+ add no_conn_cache argument
-0.38 2005-10-13 00:05
- more intelligently divide cleanup tasks (isn't ADAMK great?)
- move arg validity check constructor (to silence ADAMK)
- add some more checks for validity (stolen from ADAMK)
- add errors option and -qq commandline option for it
+0.574 2008-11-26
+ fix broken prereq declaration in Makefile.PL
-0.36 2005-01-06 18:40
- code refs can be passed to _filters, which were slightly refactored
+0.573 2008-11-25
+ switch to new File::Path API, do not suffer undef dirmodes
+ write a RECENT file of the files mirrored in the latest run
-0.32 2004-12-31 15:45
- added an old alpha binary for perl to the perls to skip
+0.572 2008-11-04
+ add 'use File::HomeDir' to CPAN/Mini.pm (thanks DAGOLDEN)
+ improve handling of trailing whitespace in config (thanks ANK)
-0.30 2004-12-28 10:00
- added a "new" method for construction
- update_mirror can act as class or instance method
- added clean_file method
+0.571 2008-05-23
+ set LWP::UserAgent's env_proxy option to use proxy (RT #36124 from
+ IFOMICHEV)
-0.26 2004-12-02 15:05
- require version 5.6 of perl in Makefile.PL
+ allow skip_cleanup in config
-0.24 2004-11-29 14:30
- dirmode is correctly octalized (thanks SSORICHE)
- sungo's *_filters patch
+0.570 2008-05-01
+ offline mode now (correctly) means that the remote is not checked for
+ availability (RT #35563)
-0.20 2004-09-28 10:20
- added config file
- added file_allowed (to override cleanup)
- the -d option, long documented, now works
+0.569 2008-04-30
+ massive speed improvements by caching connection to remote mirror
+ add offline mode (by request of ADAMK)
+ add default config file location (by request of ADAMK)
-0.18 2004-09-21 20:15
- canonpath File::Find::name to avoid horrible Win32 bug
- added -v to print version of CPAN::Mini
+0.568 2008-03-05
+ [ no code changes ]
+ fix distribution to remove resource forks (ugh!)
-0.16 2004-09-07 21:50
- added -d to set mode for created dirs
+0.567 2008-02-05
+ BUGFIX: actually respect -c option
+ internal refactoring to make subclassing easier (DAGOLDEN)
+ bring code formatting inline with other (code (simply)) code
-0.14 2004-08-28 17:05
- uses Pod::Usage
- now skips ponie and parrot (not just perl)
- -p option to override the above skipping
- "seen_changes" attribute and return value added
+0.566 2008-01-21
+ do not mirror "also_mirror" files twice (thanks DAGOLDEN)
-0.10 2004-08-26 10:50
- initial release
+0.565 2007-11-08
+ move guts of minicpan command to ::App
+ CPANTS tweaks
+ switch to Module::Install
+
+0.564 2007-10-31
+ tweak packaging for CPANTS
+
+0.563 2007-??-??
+ MAJOR BUG FIX: mirror files in ./modules
+ introduced in 0.561, this bug only affected new mirrors, so anyone
+ who had been using it before that would not have noticed
+ BUG FIX: don't be so pedantic about requiring that remote end in /
+
+0.562 2007-07-04
+ fix skip_perl to continue to skip a perl-like dist
+
+0.561 2007-07-03
+ initially mirror indices to a scratch space, so that the indices in
+ the minicpan are not replaced until all referenced files are in place
+
+ when skipping perls, also skip: kurila, perl_mlb
+
+0.552 2006-12-01
+ documentation fixes
+
+0.551 2006-11-13
+ packaging improvements
+
+0.550 2006-08-08
+ add tilde expansion for homedir in local mirror specification
+ move configuration reading into CPAN::Mini
+ document a few previously-undocumented things
+ documentation cleanup
+ added unused-by-script option to use current mtime for indices
+ (this helps CPANPLUS do the right thing)
+
+0.500 2006-07-11
+ we no longer need File::HomeDir::Win32 on Windows
+ provide the also_mirror option to get other static files
+
+0.40 2005-11-04
+ remove force option to trace
+ create local mirror if needed
+ notice if local mirror -e && ! -d
+ cleared out stupid /\A\s+\z/ lines
+
+0.38 2005-10-13 00:05
+ more intelligently divide cleanup tasks (isn't ADAMK great?)
+ move arg validity check constructor (to silence ADAMK)
+ add some more checks for validity (stolen from ADAMK)
+ add errors option and -qq commandline option for it
+
+0.36 2005-01-06 18:40
+ code refs can be passed to _filters, which were slightly refactored
+
+0.32 2004-12-31 15:45
+ added an old alpha binary for perl to the perls to skip
+
+0.30 2004-12-28 10:00
+ added a "new" method for construction
+ update_mirror can act as class or instance method
+ added clean_file method
+
+0.26 2004-12-02 15:05
+ require version 5.6 of perl in Makefile.PL
+
+0.24 2004-11-29 14:30
+ dirmode is correctly octalized (thanks SSORICHE)
+ sungo's *_filters patch
+
+0.20 2004-09-28 10:20
+ added config file
+ added file_allowed (to override cleanup)
+ the -d option, long documented, now works
+
+0.18 2004-09-21 20:15
+ canonpath File::Find::name to avoid horrible Win32 bug
+ added -v to print version of CPAN::Mini
+
+0.16 2004-09-07 21:50
+ added -d to set mode for created dirs
+
+0.14 2004-08-28 17:05
+ uses Pod::Usage
+ now skips ponie and parrot (not just perl)
+ -p option to override the above skipping
+ "seen_changes" attribute and return value added
+
+0.10 2004-08-26 10:50
+ initial release
Modified: trunk/libcpan-mini-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcpan-mini-perl/MANIFEST?rev=32835&op=diff
==============================================================================
--- trunk/libcpan-mini-perl/MANIFEST (original)
+++ trunk/libcpan-mini-perl/MANIFEST Thu Apr 9 00:16:45 2009
@@ -1,11 +1,24 @@
bin/minicpan
+Changes
+inc/Module/Install.pm
+inc/Module/Install/AutoManifest.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/ExtraTests.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
lib/CPAN/Mini.pm
-Changes
+lib/CPAN/Mini/App.pm
+LICENSE
Makefile.PL
MANIFEST This list of files
+META.yml
README
-t/00_load.t
+t/00-load.t
t/filter.t
-t/pod-coverage.t
-t/pod.t
-META.yml Module meta-data (added by MakeMaker)
+xt/release/perl-critic.t
+xt/release/pod-coverage.t
+xt/release/pod.t
Modified: trunk/libcpan-mini-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcpan-mini-perl/META.yml?rev=32835&op=diff
==============================================================================
--- trunk/libcpan-mini-perl/META.yml (original)
+++ trunk/libcpan-mini-perl/META.yml Thu Apr 9 00:16:45 2009
@@ -1,15 +1,27 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: CPAN-Mini
-version: 0.550
-version_from: lib/CPAN/Mini.pm
-installdirs: site
+---
+abstract: 'create a minimal mirror of CPAN'
+author:
+ - 'Ricardo SIGNES <rjbs at cpan.org>'
+distribution_type: module
+generated_by: 'Module::Install version 0.77'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: CPAN-Mini
+no_index:
+ directory:
+ - inc
+ - t
requires:
- Compress::Zlib: 1.20
- File::HomeDir: 0.57
- LWP: 5
- Pod::Usage: 1
- URI: 1
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+ Compress::Zlib: 1.20
+ File::HomeDir: 0.57
+ File::Path: 2.04
+ LWP: 5
+ Pod::Usage: 1.00
+ URI: 1
+ perl: 5.6.0
+resources:
+ license: http://dev.perl.org/licenses/
+ repository: http://github.com/rjbs/cpan-mini
+version: 0.576
Modified: trunk/libcpan-mini-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcpan-mini-perl/Makefile.PL?rev=32835&op=diff
==============================================================================
--- trunk/libcpan-mini-perl/Makefile.PL (original)
+++ trunk/libcpan-mini-perl/Makefile.PL Thu Apr 9 00:16:45 2009
@@ -1,16 +1,26 @@
use 5.006;
-use ExtUtils::MakeMaker;
+use strict;
+use warnings;
-WriteMakefile(
- 'NAME' => 'CPAN::Mini',
- 'VERSION_FROM' => 'lib/CPAN/Mini.pm',
- 'EXE_FILES' => [ 'bin/minicpan' ],
- 'PREREQ_PM' => {
- 'URI' => 1,
- 'LWP' => 5,
- 'Compress::Zlib' => '1.20',
- 'File::HomeDir' => '0.57', # Win32 Support
- 'Pod::Usage' => 1,
- },
- 'PREREQ_PRINT' => 1
-);
+use inc::Module::Install;
+
+name ('CPAN-Mini');
+author ('Ricardo SIGNES <rjbs at cpan.org>');
+license ('perl');
+all_from ('lib/CPAN/Mini.pm');
+
+requires(URI => 1);
+requires(LWP => 5);
+requires('Compress::Zlib' => '1.20');
+requires('File::Path' => '2.04'); # new interface, bugfixes
+requires('File::HomeDir' => '0.57'); # Win32 Support
+requires('Pod::Usage' => '1.00');
+
+extra_tests;
+
+install_script('bin/minicpan');
+
+repository('http://github.com/rjbs/cpan-mini');
+auto_manifest;
+
+WriteAll();
Modified: trunk/libcpan-mini-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcpan-mini-perl/README?rev=32835&op=diff
==============================================================================
--- trunk/libcpan-mini-perl/README (original)
+++ trunk/libcpan-mini-perl/README Thu Apr 9 00:16:45 2009
@@ -1,4 +1,4 @@
-README for CPAN::Mini
+README for CPAN::Mini 0.576
CPAN::Mini provides a simple mechanism to build and update a minimal mirror of
the CPAN on your local disk. It contains only those files needed to install
Modified: trunk/libcpan-mini-perl/bin/minicpan
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcpan-mini-perl/bin/minicpan?rev=32835&op=diff
==============================================================================
--- trunk/libcpan-mini-perl/bin/minicpan (original)
+++ trunk/libcpan-mini-perl/bin/minicpan Thu Apr 9 00:16:45 2009
@@ -1,6 +1,11 @@
#!/usr/bin/perl -w
+
use strict;
use warnings;
+use CPAN::Mini::App;
+CPAN::Mini::App->run;
+
+__END__
=head1 NAME
@@ -18,72 +23,16 @@
-p - mirror perl, ponie, and parrot distributions
-q - run in quiet mode (don't print status)
-qq - run in silent mode (don't even print warnings)
+ -c CLASS - what class to use to mirror (default: CPAN::Mini)
+ -h - print help and exit
+ -v - print version and exit
+ -x - build an exact mirror, getting even normally disallowed files
+ --offline - operate in offline mode (generally: do nothing)
=head1 DESCRIPTION
This simple shell script just updates (or creates) a miniature CPAN mirror as
described in CPAN::Mini.
-
-The local and remote mirror locations are (for now) hardcoded and should be
-updated before running this script for the first time.
-
-=cut
-
-use CPAN::Mini;
-use File::HomeDir;
-use File::Spec;
-use Getopt::Long qw(GetOptions);
-use Pod::Usage;
-
-sub display_version {
- my $class = shift;
- no strict 'refs';
- print "minicpan",
- ($class ne 'CPAN::Mini' ? ' (from CPAN::Mini)' : ''),
- ", powered by $class ", ${"$class\:\:VERSION"}, "\n\n";
- exit;
-}
-
-my %config = CPAN::Mini->read_config;
-my $class = 'CPAN::Mini';
-my $version;
-
-GetOptions(
- "c|class=s" => \$class,
- "h|help" => sub { pod2usage(1); },
- "v|version" => sub { $version = 1 },
- "l|local=s" => \$config{local},
- "r|remote=s" => \$config{remote},
- "d|dirmode=s" => \$config{dirmode},
- "qq" => sub { $config{quiet} = 2; $config{errors} = 0; },
- "q+" => \$config{quiet},
- "f+" => \$config{force},
- "p+" => \$config{perl},
- "x+" => \$config{exact_mirror},
-) or pod2usage(2);
-
-eval "require $class";
-die $@ if $@;
-
-display_version($class) if $version;
-pod2usage(2) unless $config{local} and $config{remote};
-
-$|++;
-$config{dirmode} &&= oct($config{dirmode});
-
-CPAN::Mini->update_mirror(
- remote => $config{remote},
- local => $config{local},
- trace => (not $config{quiet}),
- force => $config{force},
- dirmode => $config{dirmode},
- also_mirror => $config{also_mirror},
- exact_mirror => ($config{exact_mirror}),
- module_filters => ($config{module_filters}),
- path_filters => ($config{path_filters}),
- skip_perl => (not $config{perl}),
- (defined $config{errors} ? (errors => $config{errors}) : ()),
-);
=head1 CONFIGURATION FILE
@@ -107,9 +56,11 @@
=head1 AUTHORS
-Randal Schwartz <F<merlyn at stonehenge.com>> did all the work.
+Randal Schwartz <F<merlyn at stonehenge.com>> had the bright idea and wrote the
+original implementation.
-Ricardo SIGNES <F<rjbs at cpan.org>> made a module and distribution.
+Ricardo SIGNES <F<rjbs at cpan.org>> brazenly took the script, made a module and
+distribution, and slowly allowed it to gain features.
This code was copyrighted in 2004, and is released under the same terms as Perl
itself.
Modified: trunk/libcpan-mini-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcpan-mini-perl/debian/changelog?rev=32835&op=diff
==============================================================================
--- trunk/libcpan-mini-perl/debian/changelog (original)
+++ trunk/libcpan-mini-perl/debian/changelog Thu Apr 9 00:16:45 2009
@@ -1,4 +1,4 @@
-libcpan-mini-perl (0.550-1.2) UNRELEASED; urgency=low
+libcpan-mini-perl (0.576-1) UNRELEASED; urgency=low
* Take over for the Debian Perl Group; Closes: #523127 -- RFA
* debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
@@ -9,8 +9,10 @@
Uploaders.
* Add debian/watch.
* add myself to uploaders, remove previous maintainer
+ * New upstream release
+ * Debian Policy 3.8.1
- -- Ryan Niebur <ryanryan52 at gmail.com> Wed, 08 Apr 2009 17:14:46 -0700
+ -- Ryan Niebur <ryanryan52 at gmail.com> Wed, 08 Apr 2009 17:16:36 -0700
libcpan-mini-perl (0.550-1.1) unstable; urgency=low
Modified: trunk/libcpan-mini-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcpan-mini-perl/debian/control?rev=32835&op=diff
==============================================================================
--- trunk/libcpan-mini-perl/debian/control (original)
+++ trunk/libcpan-mini-perl/debian/control Thu Apr 9 00:16:45 2009
@@ -5,7 +5,7 @@
Build-Depends-Indep: perl (>= 5.8.0-7), liburi-perl, libcompress-zlib-perl, libwww-perl, libtest-pod-perl, libtest-pod-coverage-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Ryan Niebur <ryanryan52 at gmail.com>
-Standards-Version: 3.7.2
+Standards-Version: 3.8.1
Homepage: http://search.cpan.org/dist/CPAN-Mini/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libcpan-mini-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libcpan-mini-perl/
Modified: trunk/libcpan-mini-perl/lib/CPAN/Mini.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcpan-mini-perl/lib/CPAN/Mini.pm?rev=32835&op=diff
==============================================================================
--- trunk/libcpan-mini-perl/lib/CPAN/Mini.pm (original)
+++ trunk/libcpan-mini-perl/lib/CPAN/Mini.pm Thu Apr 9 00:16:45 2009
@@ -1,18 +1,19 @@
-package CPAN::Mini;
-our $VERSION = '0.550';
-
+use 5.006;
use strict;
use warnings;
+package CPAN::Mini;
+our $VERSION = '0.576';
+
+## no critic RequireCarping
+
=head1 NAME
CPAN::Mini - create a minimal mirror of CPAN
=head1 VERSION
-version 0.550
-
- $Id: /my/cs/projects/minicpan/trunk/lib/CPAN/Mini.pm 24759 2006-08-08T22:42:40.881515Z rjbs $
+version 0.576
=head1 SYNOPSIS
@@ -49,13 +50,16 @@
use Carp ();
-use File::Path ();
use File::Basename ();
+use File::Copy ();
+use File::HomeDir ();
+use File::Find ();
+use File::Path 2.04 ();
use File::Spec ();
-use File::Find ();
+use File::Temp ();
use URI ();
-use LWP::Simple ();
+use LWP::UserAgent ();
use Compress::Zlib ();
@@ -88,6 +92,10 @@
Generally an octal number, this option sets the permissions of created
directories. It defaults to 0711.
+=item * C<exact_mirror>
+
+If true, the C<files_allowed> method will allow all extra files to be mirrored.
+
=item * C<force>
If true, this option will cause CPAN::Mini to read the entire module list and
@@ -140,49 +148,94 @@
If this option is true, CPAN::Mini will not try delete unmirrored files when it
has finished mirroring
+=item * C<offline>
+
+If offline, CPAN::Mini will not attempt to contact remote resources.
+
+=item * C<no_conn_cache>
+
+If true, no connection cache will be established. This is mostly useful as a
+workaround for connection cache failures.
+
=back
=cut
sub update_mirror {
- my $self = shift;
- $self = $self->new(@_) unless ref $self;
-
- # mirrored tracks the already done, keyed by filename
- # 1 = local-checked, 2 = remote-mirrored
- $self->mirror_indices;
-
- return unless $self->{force} or $self->{changes_made};
-
- # now walk the packages list
- my $details = File::Spec->catfile(
- $self->{local},
- qw(modules 02packages.details.txt.gz)
- );
-
- my $gz = Compress::Zlib::gzopen($details, "rb")
+ my $self = shift;
+ $self = $self->new(@_) unless ref $self;
+
+ unless ($self->{offline}) {
+ # mirrored tracks the already done, keyed by filename
+ # 1 = local-checked, 2 = remote-mirrored
+ $self->mirror_indices;
+
+ return unless $self->{force} or $self->{changes_made};
+
+ # mirror all the files
+ $self->_mirror_extras;
+ $self->mirror_file($_, 1) for @{ $self->_get_mirror_list };
+
+ # install indices after files are mirrored in case we're interrupted
+ # so indices will seem new again when continuing
+ $self->_install_indices;
+
+ $self->_write_out_recent;
+
+ # eliminate files we don't need
+ $self->clean_unmirrored unless $self->{skip_cleanup};
+ }
+
+ return $self->{changes_made};
+}
+
+sub _recent { $_[0]->{recent}{$_[1]} = 1 };
+
+sub _write_out_recent {
+ my ($self) = @_;
+ return unless my @keys = keys %{ $self->{recent} };
+
+ my $recent = File::Spec->catfile($self->{local}, 'RECENT');
+ open my $recent_fh, '>', $recent or die "can't open $recent for writing: $!";
+
+ for my $file (sort keys %{ $self->{recent} }) {
+ print $recent_fh "$file\n" or die "can't write to $recent: $!";
+ }
+
+ die "error closing $recent: $!" unless close $recent_fh;
+ return;
+}
+
+sub _get_mirror_list {
+ my $self = shift;
+
+ my %mirror_list;
+
+ # now walk the packages list
+ my $details = File::Spec->catfile($self->{scratch},
+ qw(modules 02packages.details.txt.gz));
+
+ my $gz = Compress::Zlib::gzopen($details, "rb")
or die "Cannot open details: $Compress::Zlib::gzerrno";
- my $inheader = 1;
- while ($gz->gzreadline($_) > 0) {
- if ($inheader) {
- $inheader = 0 unless /\S/;
- next;
- }
-
- my ($module, $version, $path) = split;
- next if $self->_filter_module({
- module => $module,
- version => $version,
- path => $path,
- });
-
- $self->mirror_file("authors/id/$path", 1);
- }
-
- # eliminate files we don't need
- $self->clean_unmirrored unless $self->{skip_cleanup};
- return $self->{changes_made};
+ my $inheader = 1;
+ while ($gz->gzreadline($_) > 0) {
+ if ($inheader) {
+ $inheader = 0 unless /\S/;
+ next;
+ }
+
+ my ($module, $version, $path) = split;
+ next if $self->_filter_module({
+ module => $module,
+ version => $version,
+ path => $path,
+ });
+
+ $mirror_list{"authors/id/$path"}++;
+ }
+
+ return [ sort keys %mirror_list ];
}
=head2 new
@@ -195,35 +248,61 @@
=cut
sub new {
- my $class = shift;
- my %defaults = (
+ my $class = shift;
+ my %defaults = (
changes_made => 0,
- dirmode => 0711,
+ dirmode => 0711, ## no critic Zero
errors => 1,
mirrored => {}
);
- my $self = bless { %defaults, @_ } => $class;
-
- Carp::croak "no local mirror supplied" unless $self->{local};
+ my $self = bless { %defaults, @_ } => $class;
+
+ $self->{dirmode} = $defaults{dirmode} unless defined $self->{dirmode};
+
+ $self->{recent} = {};
+ $self->{scratch} ||= File::Temp::tempdir(CLEANUP => 1);
+
+ Carp::croak "no local mirror supplied" unless $self->{local};
substr($self->{local}, 0, 1, $class->__homedir)
- if substr($self->{local}, 0, 1) eq '~';
+ if substr($self->{local}, 0, 1) eq q{~};
Carp::croak "local mirror path exists but is not a directory"
- if (-e $self->{local}) and not (-d $self->{local});
-
- File::Path::mkpath($self->{local}, $self->{trace}, $self->{dirmode})
- unless -e $self->{local};
+ if (-e $self->{local})
+ and not(-d $self->{local});
+
+ unless (-e $self->{local}) {
+ File::Path::mkpath(
+ $self->{local},
+ {
+ verbose => $self->{trace},
+ mode => $self->{dirmode},
+ },
+ );
+ }
Carp::croak "no write permission to local mirror" unless -w $self->{local};
- Carp::croak "no remote mirror supplied" unless $self->{remote};
- Carp::croak "unable to contact the remote mirror"
- unless LWP::Simple::head($self->{remote});
-
- return $self;
-}
+ Carp::croak "no remote mirror supplied" unless $self->{remote};
+
+ $self->{remote} = "$self->{remote}/" if substr($self->{remote}, -1) ne '/';
+
+ $self->{__lwp} = LWP::UserAgent->new(
+ agent => "$class/" . $class->VERSION,
+ env_proxy => 1,
+ ($self->{no_conn_cache} ? () : (keep_alive => 5)),
+ );
+
+ unless ($self->{offline}) {
+ Carp::croak "unable to contact the remote mirror"
+ unless eval { $self->__lwp->head($self->{remote})->is_success };
+ }
+
+ return $self;
+}
+
+sub __lwp { $_[0]->{__lwp} }
=head2 mirror_indices
@@ -233,17 +312,70 @@
=cut
+sub _fixed_mirrors {
+ qw(
+ authors/01mailrc.txt.gz
+ modules/02packages.details.txt.gz
+ modules/03modlist.data.gz
+ );
+}
+
sub mirror_indices {
- my $self = shift;
-
- my @fixed_mirrors = qw(
- authors/01mailrc.txt.gz
- modules/02packages.details.txt.gz
- modules/03modlist.data.gz
+ my $self = shift;
+
+ $self->_make_index_dirs($self->{scratch});
+
+ for my $path ($self->_fixed_mirrors) {
+ my $local_file = File::Spec->catfile($self->{local}, split m{/}, $path);
+ my $scratch_file = File::Spec->catfile($self->{scratch}, split m{/}, $path);
+
+ File::Copy::copy($local_file, $scratch_file);
+
+ utime((stat $local_file)[ 8, 9 ], $scratch_file);
+
+ $self->mirror_file($path, undef, { to_scratch => 1 });
+ }
+}
+
+sub _mirror_extras {
+ my $self = shift;
+
+ for my $path (@{ $self->{also_mirror} }) {
+ $self->mirror_file($path, undef);
+ }
+}
+
+sub _make_index_dirs {
+ my ($self, $base_dir, $dir_mode, $trace) = @_;
+ $base_dir ||= $self->{scratch};
+ $dir_mode = 0711 if !defined $dir_mode; ## no critic Zero
+ $trace = 0 if !defined $trace;
+
+ for my $index ($self->_fixed_mirrors) {
+ my $dir = File::Basename::dirname($index);
+ my $needed = File::Spec->catdir($base_dir, $dir);
+ File::Path::mkpath($needed, { verbose => $trace, mode => $dir_mode });
+ die "couldn't create $needed: $!" unless -d $needed;
+ }
+}
+
+sub _install_indices {
+ my $self = shift;
+
+ $self->_make_index_dirs($self->{local}, $self->{dirmode}, $self->{trace});
+
+ for my $file ($self->_fixed_mirrors) {
+ my $local_file = File::Spec->catfile($self->{local}, split m{/}, $file);
+
+ unlink $local_file;
+
+ File::Copy::copy(
+ File::Spec->catfile($self->{scratch}, split m{/}, $file),
+ $local_file,
);
- # XXX: Should the 0 be a 1, below? -- rjbs, 2006-08-08
- $self->mirror_file($_, undef, 0) for @fixed_mirrors, @{$self->{also_mirror}};
+ $self->{mirrored}{$local_file} = 1;
+ }
}
=head2 mirror_file
@@ -256,105 +388,115 @@
=cut
sub mirror_file {
- my $self = shift;
- my $path = shift; # partial URL
- my $skip_if_present = shift; # true/false
- my $update_times = shift; # true/false
+ my ($self, $path, $skip_if_present, $arg) = @_;
+
+ $arg ||= {};
# full URL
- my $remote_uri = URI->new_abs($path, $self->{remote})->as_string;
+ my $remote_uri
+ = eval { $path->isa('URI') }
+ ? $path
+ : URI->new_abs($path, $self->{remote})->as_string;
# native absolute file
- my $local_file = File::Spec->catfile($self->{local}, split "/", $path);
-
- my $checksum_might_be_up_to_date = 1;
-
- if ($skip_if_present and -f $local_file) {
- ## upgrade to checked if not already
- $self->{mirrored}{$local_file} = 1 unless $self->{mirrored}{$local_file};
- } elsif (($self->{mirrored}{$local_file} || 0) < 2) {
- ## upgrade to full mirror
- $self->{mirrored}{$local_file} = 2;
-
- File::Path::mkpath(
+ my $local_file = File::Spec->catfile(
+ $arg->{to_scratch} ? $self->{scratch} : $self->{local},
+ split m{/}, $path
+ );
+
+ my $checksum_might_be_up_to_date = 1;
+
+ if ($skip_if_present and -f $local_file) {
+ ## upgrade to checked if not already
+ $self->{mirrored}{$local_file} ||= 1;
+ } elsif (($self->{mirrored}{$local_file} || 0) < 2) {
+ ## upgrade to full mirror
+ $self->{mirrored}{$local_file} = 2;
+
+ File::Path::mkpath(
File::Basename::dirname($local_file),
- $self->{trace},
- $self->{dirmode}
+ {
+ verbose => $self->{trace},
+ mode => $self->{dirmode},
+ },
);
- $self->trace($path);
- my $status = LWP::Simple::mirror($remote_uri, $local_file);
-
- if ($status == LWP::Simple::RC_OK) {
- utime undef, undef, $local_file if $update_times;
- $checksum_might_be_up_to_date = 0;
- $self->trace(" ... updated\n");
- $self->{changes_made}++;
- } elsif ($status != LWP::Simple::RC_NOT_MODIFIED) {
- warn( ($self->{trace} ? "\n" : '')
- . "$remote_uri: $status\n") if $self->{errors};
- return;
- } else {
- $self->trace(" ... up to date\n");
- }
- }
-
- if ($path =~ m{^authors/id}) { # maybe fetch CHECKSUMS
- my $checksum_path =
- URI->new_abs("CHECKSUMS", $remote_uri)->rel($self->{remote});
- if ($path ne $checksum_path) {
- $self->mirror_file($checksum_path, $checksum_might_be_up_to_date);
- }
- }
+ $self->trace($path);
+ my $res = $self->{__lwp}->mirror($remote_uri, $local_file);
+
+ if ($res->is_success) {
+ utime undef, undef, $local_file if $arg->{update_times};
+ $checksum_might_be_up_to_date = 0;
+ $self->_recent($path);
+ $self->trace(" ... updated\n");
+ $self->{changes_made}++;
+ } elsif ($res->code != 304) { # not modified
+ warn(($self->{trace} ? "\n" : q{}) . "$remote_uri: " . $res->status_line . "\n")
+ if $self->{errors};
+ return;
+ } else {
+ $self->trace(" ... up to date\n");
+ }
+ }
+
+ if ($path =~ m{^authors/id}) { # maybe fetch CHECKSUMS
+ my $checksum_path
+ = URI->new_abs("CHECKSUMS", $remote_uri)->rel($self->{remote})->as_string;
+
+ if ($path ne $checksum_path) {
+ $self->mirror_file($checksum_path, $checksum_might_be_up_to_date);
+ }
+ }
}
=begin devel
=head2 _filter_module
- next if
- $self->_filter_module({ module => $foo, version => $foo, path => $foo });
-
-This internal-only method encapsulates the logic where we figure out if a
-module is to be mirrored or not. Better stated, this method holds the filter
-chain logic. C<update_mirror()> takes an optional set of filter parameters. As
-C<update_mirror()> encounters a distribution, it calls this method to figure
-out whether or not it should be downloaded. The user provided filters are taken
-into account. Returns 1 if the distribution is filtered (to be skipped).
-Returns 0 if the distribution is to not filtered (not to be skipped).
+ next
+ if $self->_filter_module({ module => $foo, version => $foo, path => $foo });
+
+This method holds the filter chain logic. C<update_mirror> takes an optional
+set of filter parameters. As C<update_mirror> encounters a distribution, it
+calls this method to figure out whether or not it should be downloaded. The
+user provided filters are taken into account. Returns 1 if the distribution is
+filtered (to be skipped). Returns 0 if the distribution is to not filtered
+(not to be skipped).
=end devel
=cut
sub __do_filter {
- my ($self, $filter, $file) = @_;
- return unless $filter;
- if (ref($filter) eq 'ARRAY') {
- for (@$filter) {
- return 1 if $self->__do_filter($_, $file);
- }
- }
- if (ref($filter) eq 'CODE') {
- return $filter->($file);
- } else {
- return $file =~ $filter;
- }
+ my ($self, $filter, $file) = @_;
+ return unless $filter;
+ if (ref($filter) eq 'ARRAY') {
+ for (@$filter) {
+ return 1 if $self->__do_filter($_, $file);
+ }
+ }
+ if (ref($filter) eq 'CODE') {
+ return $filter->($file);
+ } else {
+ return $file =~ $filter;
+ }
}
sub _filter_module {
- my $self = shift;
- my $args = shift;
-
- if ($self->{skip_perl}) {
- return 1 if $args->{path} =~ m{/(?:emb|syb|bio)*perl-\d}i;
- return 1 if $args->{path} =~ m{/(?:parrot|ponie)-\d}i;
- return 1 if $args->{path} =~ m{/\bperl5\.004}i;
- }
-
- return 1 if $self->__do_filter($self->{path_filters}, $args->{path});
- return 1 if $self->__do_filter($self->{module_filters}, $args->{module});
- return 0;
+ my $self = shift;
+ my $args = shift;
+
+ if ($self->{skip_perl}) {
+ return 1 if $args->{path} =~ m{/(?:emb|syb|bio)?perl-\d}i;
+ return 1 if $args->{path} =~ m{/(?:parrot|ponie)-\d}i;
+ return 1 if $args->{path} =~ m{/(?:kurila)-\d}i;
+ return 1 if $args->{path} =~ m{/\bperl-?5\.004}i;
+ return 1 if $args->{path} =~ m{/\bperl_mlb\.zip}i;
+ }
+
+ return 1 if $self->__do_filter($self->{path_filters}, $args->{path});
+ return 1 if $self->__do_filter($self->{module_filters}, $args->{module});
+ return 0;
}
=head2 file_allowed
@@ -364,14 +506,19 @@
This method returns true if the given file is allowed to exist in the local
mirror, even if it isn't one of the required mirror files.
-By default, only dot-files are allowed.
+By default, only dot-files are allowed. If the C<exact_mirror> option is true,
+all files are allowed.
=cut
sub file_allowed {
- my ($self, $file) = @_;
- return if $self->{exact_mirror};
- return (substr(File::Basename::basename($file),0,1) eq '.') ? 1 : 0;
+ my ($self, $file) = @_;
+ return if $self->{exact_mirror};
+
+ # It's a cheap hack, but it gets the job done.
+ return 1 if $file eq File::Spec->catfile($self->{local}, 'RECENT');
+
+ return (substr(File::Basename::basename($file), 0, 1) eq q{.}) ? 1 : 0;
}
=head2 clean_unmirrored
@@ -385,19 +532,19 @@
=cut
sub clean_unmirrored {
- my $self = shift;
-
- File::Find::find sub {
- my $file = File::Spec->canonpath($File::Find::name);
+ my $self = shift;
+
+ File::Find::find sub {
+ my $file = File::Spec->canonpath($File::Find::name); ## no critic Package
return unless (-f $file and not $self->{mirrored}{$file});
return if $self->file_allowed($file);
$self->trace("cleaning $file ...");
- if ($self->clean_file($file)) {
+ if ($self->clean_file($file)) {
$self->trace("done\n");
} else {
$self->trace("couldn't be cleaned\n");
}
- }, $self->{local};
+ }, $self->{local};
}
=head2 clean_file
@@ -410,12 +557,13 @@
=cut
sub clean_file {
- my ($self, $file) = @_;
-
- unless (unlink $file) {
- warn "$file ... cannot be removed: $!" if $self->{errors};
+ my ($self, $file) = @_;
+
+ unless (unlink $file) {
+ warn "$file ... cannot be removed: $!\n" if $self->{errors};
return;
}
+
return 1;
}
@@ -429,8 +577,8 @@
=cut
sub trace {
- my ($self, $message) = @_;
- print "$message" if $self->{trace};
+ my ($self, $message) = @_;
+ print $message if $self->{trace};
}
=head2 read_config
@@ -451,8 +599,15 @@
Carp::croak "couldn't determine your home directory! set HOME env variable"
unless defined $homedir;
-
+
return $homedir;
+}
+
+sub __default_configfile {
+ my ($self) = @_;
+
+ (my $pm_loc = $INC{'CPAN/Mini.pm'}) =~ s/Mini\.pm\z//;
+ File::Spec->catfile($pm_loc, 'minicpan.conf');
}
sub read_config {
@@ -460,23 +615,27 @@
my $filename = File::Spec->catfile($class->__homedir, '.minicpanrc');
+ $filename = $class->__default_configfile unless -e $filename;
return unless -e $filename;
open my $config_file, '<', $filename
or die "couldn't open config file $filename: $!";
-
+
my %config;
- while (<$config_file>) {
+ while (<$config_file>) {
chomp;
next if /\A\s*\Z/sm;
- if (/\A(\w+):\s*(.+)\Z/sm) { $config{$1} = $2; }
- }
+ if (/\A(\w+):\s*(\S.*?)\s*\Z/sm) { $config{$1} = $2; }
+ }
+
for (qw(also_mirror)) {
- $config{$_} = [ grep { length } split /\s+/, $config{$_}] if $config{$_};
- }
+ $config{$_} = [ grep { length } split /\s+/, $config{$_} ] if $config{$_};
+ }
+
for (qw(module_filters path_filters)) {
$config{$_} = [ map { qr/$_/ } split /\s+/, $config{$_} ] if $config{$_};
}
+
return %config;
}
@@ -505,6 +664,11 @@
Thanks to Adam Kennedy for noticing and complaining about a lot of stupid
little design decisions.
+Thanks to Michael Schwern and Jason Kohles, for pointing out missing
+documentation.
+
+Thanks to David Golden for some important bugfixes and refactoring.
+
=head1 AUTHORS
Randal Schwartz <F<merlyn at stonehenge.com>> wrote the original F<minicpan>
More information about the Pkg-perl-cvs-commits
mailing list