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