Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

1. Created lib/CPAN/Mini/Visit/Simple/Auxiliary.pm to hold helper sub…

…routines

dedupe_superseded() and normalize_version_number().
2.  Revised method say_list() to accept a hashref in which an output file
could be specified.  Wrote tests for that functionality.
3.  Created BUILD_REQUIRES in Makefile.PL to hold modules only used in build
(testing).
  • Loading branch information...
commit e2a99e561b745f72004c9503efd77e132b0b2aa4 1 parent a3cbbfb
@jkeenan authored
View
1  MANIFEST
@@ -1,5 +1,6 @@
Changes
lib/CPAN/Mini/Visit/Simple.pm
+lib/CPAN/Mini/Visit/Simple/Auxiliary.pm
LICENSE
Makefile.PL
MANIFEST
View
9 Makefile.PL
@@ -4,18 +4,19 @@ use ExtUtils::MakeMaker;
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'CPAN::Mini::Visit::Simple',
- VERSION_FROM => 'lib/CPAN/Mini/Visit/Simple.pm', # finds \$VERSION
+ VERSION_FROM => 'lib/CPAN/Mini/Visit/Simple.pm',
AUTHOR => 'James E Keenan (jkeenan@cpan.org)',
ABSTRACT => 'Lightweight traversal of a minicpan repository',
PREREQ_PM => {
'CPAN::Mini' => 0,
'File::Find' => 0,
- 'File::Path' => 2.06,
'File::Spec' => 0,
'File::Temp' => 0.14,
- 'IO::CaptureOutput' => 0,
-# 'Path::Class' => 0,
'Scalar::Util' => 0,
+ },
+ BUILD_REQUIRES => {
+ 'File::Path' => 2.06,
+ 'IO::CaptureOutput' => 0,
'Test::Simple' => 0.44,
},
);
View
22 lib/CPAN/Mini/Visit/Simple.pm
@@ -11,6 +11,9 @@ use CPAN::Mini ();
use File::Find;
use File::Spec;
use Scalar::Util qw/ reftype /;
+use CPAN::Mini::Visit::Simple::Auxiliary qw(
+ dedupe_superseded
+);
sub new {
my ($class, $args) = @_;
@@ -44,7 +47,7 @@ sub identify_distros {
unless reftype($args->{list}) eq 'ARRAY';
croak "Value of 'list' must be non-empty"
unless scalar(@{$args->{list}});
- $self->{list} = $args->{list};
+ $self->{list} = dedupe_superseded( $args->{list} );
return 1;
}
@@ -81,13 +84,24 @@ sub identify_distros {
},
$self->{start_dir},
);
- $self->{list} = \@found;
+ $self->{list} = dedupe_superseded( \@found );
return 1;
}
sub say_list {
- my ($self) = @_;
- say $_ for @{$self->{list}};
+ my ($self, $args) = @_;
+ if (not defined $args) {
+ say $_ for @{$self->{list}};
+ }
+ else {
+ croak "Argument must be hashref" unless reftype($args) eq 'HASH';
+ croak "Need 'file' element in hashref" unless exists $args->{file};
+ open my $FH, '>', $args->{file}
+ or croak "Unable to open handle to $args->{file} for writing";
+ say $FH $_ for @{$self->{list}};
+ close $FH
+ or croak "Unable to close handle to $args->{file} after writing";
+ }
}
1;
View
14 lib/CPAN/Mini/Visit/Simple.pod
@@ -17,8 +17,6 @@ can be used in the following circumstances:
=head2 C<new()>
-=cut
-
=over 4
=item * Purpose
@@ -47,8 +45,6 @@ CPAN::Mini::Visit::Simple object.
=head2 C<identify_distros()>
-=cut
-
=over 4
=item * Purpose
@@ -144,13 +140,19 @@ accessed by other methods.
=item * Purpose
-Prints to STDOUT a list of distributions to be visited.
+Prints a list of distributions to be visited.
=item * Arguments
$self->say_list();
-None.
+or
+
+ $self->say_list( { file => /path/to/list } );
+
+Optional single hashref. Hash must have C<file> element whose value is
+absolute path to a file to which list is written. Otherwise, output is simply
+sent to STDOUT.
=item * Return Value
View
188 lib/CPAN/Mini/Visit/Simple/Auxiliary.pm
@@ -0,0 +1,188 @@
+package CPAN::Mini::Visit::Simple::Auxiliary;
+use 5.010;
+use strict;
+use warnings;
+our @ISA = qw( Exporter );
+our @EXPORT_OK = qw(
+ dedupe_superseded
+ normalize_version_number
+);
+use File::Basename;
+use File::Spec;
+
+sub dedupe_superseded {
+ my $listref = shift;
+ my (%version_seen, @newlist);
+ foreach my $distro (@$listref) {
+ my $dir = dirname($distro);
+ my $base = basename($distro);
+ my $archive_re = qr{\.(?:tar\.(?:bz2|gz|Z)|t(?:gz|bz)|zip\.gz)$}i;
+ if ($base =~ m/^(.*)-([\d\.]+)(?:$archive_re)/) {
+ my ($stem, $version) = ($1,$2);
+ my $k = File::Spec->catfile($dir, $stem);
+ if ( not $version_seen{$k}{version} ) {
+ $version_seen{$k} = {
+ distro => $distro,
+ version => normalize_version_number($version),
+ };
+ }
+ else {
+ my $norm_current =
+ normalize_version_number($version_seen{$k}{version});
+ my $norm_new = normalize_version_number($version);
+ if ( $norm_new > $norm_current ) {
+ $version_seen{$k} = {
+ distro => $distro,
+ version => $norm_new,
+ };
+ }
+ }
+ }
+ else {
+ push @newlist, $distro;
+ }
+ }
+ foreach my $k (keys %version_seen) {
+ push @newlist, $version_seen{$k}{distro};
+ }
+ return [ sort @newlist ];
+}
+
+sub normalize_version_number {
+ my $v = shift;
+ my @captures = split /\./, $v;
+ my $normalized = "$captures[0].";
+ $normalized =~ s/^0+?(\d+\.)/$1/;
+ for my $cap (@captures[1..$#captures]) {
+ $normalized .= sprintf("%05d", $cap);
+ }
+ $normalized =~ s/-//g;
+ return $normalized;
+}
+
+1;
+
+
+=head1 NAME
+
+CPAN::Mini::Visit::Simple::Auxiliary - Helper functions for CPAN::Mini::Visit::Simple
+
+=head1 SYNOPSIS
+
+ use CPAN::Mini::Visit::Simple::Auxiliary qw(
+ dedupe_superseded
+ );
+
+=head1 DESCRIPTION
+
+This package provides subroutines, exported on demand only, which are used in
+Perl extension CPAN-Mini-Visit-Simple and its test suite.
+
+=head1 SUBROUTINES
+
+=head2 C<dedupe_superseded()>
+
+=over 4
+
+=item * Purpose
+
+Due to what is probably a bug in CPAN::Mini, a minicpan repository may, under
+its F<author/id/> directory, contain two or more versions of a single CPAN
+distribution. Example:
+
+ minicpan/authors/id/D/DR/DROLSKY/Class-MOP-0.82.tar.gz
+ minicpan/authors/id/D/DR/DROLSKY/Class-MOP-0.88.tar.gz
+ minicpan/authors/id/D/DR/DROLSKY/Class-MOP-0.98.tar.gz
+
+This I<may> be due to an algorithm which searches for the most recent version
+of each Perl I<module> on CPAN and then places the I<distribution> in which it
+is found in the minicpan -- even if that module is not found in the most
+recent version of the distribution.
+
+Be this as it may, if you are using a minicpan, chances are that you really
+want only the most recent version of a particular CPAN distribution and that
+you don't care about packages found in older versions which have been deleted
+by the author/maintainer (presumably for good reason) from the newest
+version.
+
+So when you traverse a minicpan to compose a list of distributions, you
+probably want that list I<deduplicated> by stripping out older, presumably
+superseded versions of distributions. This function tries to accomplish
+that. It does I<not> try to be omniscient. In particular, it does not strip
+out distributions with letters in their versions. So, faced with a situation
+like this:
+
+ minicpan/authors/id/D/DR/DROLSKY/Class-MOP-0.82.tar.gz
+ minicpan/authors/id/D/DR/DROLSKY/Class-MOP-0.88.tar.gz
+ minicpan/authors/id/D/DR/DROLSKY/Class-MOP-0.98.tar.gz
+ minicpan/authors/id/D/DR/DROLSKY/Class-MOP-0.98b.tar.gz
+
+... it will dedupe this listing to:
+
+ minicpan/authors/id/D/DR/DROLSKY/Class-MOP-0.98.tar.gz
+ minicpan/authors/id/D/DR/DROLSKY/Class-MOP-0.98b.tar.gz
+
+=item * Arguments
+
+ $newlist_ref = dedupe_superseded(\@list);
+
+One argument: Reference to an array holding a list of distributions needing
+to be duplicated.
+
+=item * Return Value
+
+Reference to an array holding a deduplicated list.
+
+=back
+
+=head2 C<normalize_version_number()>
+
+=over 4
+
+=item * Purpose
+
+Yet another attempt to deal with version number madness. No attempt to claim
+that this is the absolutely correct way to create comparable version numbers.
+
+=item * Arguments
+
+ $new_version = normalize_version_number($old_version),
+
+One argument: Version number, hopefully in two or more
+decimal-point-delimited parts.
+
+=item * Return Value
+
+A version number in which 'minor version', 'patch version', etc., have been
+changed to C<0>-padded 5-digit numbers.
+
+=back
+
+=head1 BUGS
+
+Report bugs at
+F<https://rt.cpan.org/Public/Bug/Report.html?Queue=CPAN-Mini-Visit-Simple>.
+
+=head1 AUTHOR
+
+ James E Keenan
+ CPAN ID: jkeenan
+ Perl Seminar NY
+ jkeenan@cpan.org
+ http://thenceforward.net/perl/modules/CPAN-Mini-Visit-Simple/
+
+=head1 COPYRIGHT
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+
+=head1 SEE ALSO
+
+CPAN-Mini. CPAN-Mini-Visit-Simple.
+
+=cut
+
View
52 t/002_identify_distros.t
@@ -6,9 +6,10 @@ use CPAN::Mini::Visit::Simple;
use Carp;
use File::Path qw( make_path );
use File::Spec;
-use File::Temp qw( tempdir );
+use File::Temp qw( tempfile tempdir );
use IO::CaptureOutput qw( capture );
-use Test::More tests => 23;
+use Tie::File;
+use Test::More qw(no_plan); # tests => 23;
my ( $self, $rv, @list, $phony_minicpan, $tdir, $id_dir );
@@ -31,14 +32,16 @@ eval {
like($@, qr/Value of 'list' must be non-empty/,
"Got expected error message for bad 'list' value -- must be non-empty array ref" );
-@list = qw(
- /home/user/minicpan/authors/id/A/AA/AARDVARK/Alpha-Beta-0.01-tar.gz
- /home/user/minicpan/authors/id/A/AA/AARDVARK/Gamma-Delta-0.02-tar.gz
- /home/user/minicpan/authors/id/A/AA/AARDVARK/Epsilon-Zeta-0.03-tar.gz
-);
-ok( $self->identify_distros({ list => \@list, }),
- "identify_distros() returned true value" );
{
+ $self = CPAN::Mini::Visit::Simple->new({});
+ @list = qw(
+ /home/user/minicpan/authors/id/A/AA/AARDVARK/Alpha-Beta-0.01-tar.gz
+ /home/user/minicpan/authors/id/A/AA/AARDVARK/Gamma-Delta-0.02-tar.gz
+ /home/user/minicpan/authors/id/A/AA/AARDVARK/Epsilon-Zeta-0.03-tar.gz
+ );
+ ok( $self->identify_distros({ list => \@list, }),
+ "identify_distros() returned true value" );
+
my ($stdout, $stderr);
capture(
sub { $self->say_list(); },
@@ -50,6 +53,33 @@ ok( $self->identify_distros({ list => \@list, }),
$seen++ if $stdout =~ m/$el/;
}
is( $seen, scalar(@list), "All distro names seen on STDOUT" );
+
+ my %list_seen = map { $_ => 1 } @list;
+ my ($fh, $tfile) = tempfile();
+ $self->say_list( { file => $tfile } );
+ my @lines;
+ my $nonmatch = 0;
+ tie @lines, 'Tie::File', $tfile or croak "Unable to tie to $tfile";
+ my %lines_seen = map { $_ => 1 } @lines;
+ untie @lines or croak "Unable to untie from $tfile";
+ foreach my $j (keys %list_seen) {
+ foreach my $k (keys %lines_seen) {
+ $nonmatch++ unless $lines_seen{$j};
+ }
+ };
+ is( $nonmatch, 0, "All distros printed to file" );
+
+ eval {
+ $self->say_list( [] );
+ };
+ like($@, qr/Argument must be hashref/,
+ "Optional 'say_list()' argument must be a hashref" );
+
+ eval {
+ $self->say_list( { nofile => 'nothing' } );
+ };
+ like($@, qr/Need 'file' element in hashref/,
+ "'say_list()' requires 'file' element in hashref" );
}
$self = CPAN::Mini::Visit::Simple->new({});
@@ -63,7 +93,7 @@ like($@, qr/Directory $phony_minicpan not found/,
"Got expected error message for bad 'start_dir' value" );
{
- $tdir = tempdir();
+ $tdir = tempdir( CLEANUP => 1 );
ok( -d $tdir, "tempdir directory created for testing" );
$id_dir = File::Spec->catdir($tdir, qw/authors id/);
make_path($id_dir, { mode => 0711 });
@@ -85,7 +115,7 @@ like($@, qr/Directory $phony_minicpan not found/,
}
{
- $tdir = tempdir();
+ $tdir = tempdir( CLEANUP => 1 );
ok( -d $tdir, "tempdir directory created for testing" );
$id_dir = File::Spec->catdir($tdir, qw/authors id/);
make_path($id_dir, { mode => 0711 });
Please sign in to comment.
Something went wrong with that request. Please try again.