Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Extensive debugging on method refresh_list(). Document it better and …

…test it better. Needs refactoring and additional tests.
  • Loading branch information...
commit dee2930ad7d56ffd0b0f9aad226bf7441d752c1a 1 parent 274efe7
@jkeenan authored
View
90 lib/CPAN/Mini/Visit/Simple.pm
@@ -8,14 +8,16 @@ $VERSION = eval $VERSION; ## no critic
use Carp;
use CPAN::Mini ();
+use File::Basename qw/ dirname basename /;
use File::Find;
use File::Spec;
use Scalar::Util qw/ reftype /;
use CPAN::Mini::Visit::Simple::Auxiliary qw(
$ARCHIVE_REGEX
dedupe_superseded
+ normalize_version_number
);
-use Data::Dumper;$Data::Dumper::Indent=1;
+#use Data::Dumper;$Data::Dumper::Indent=1;
sub new {
my ($class, $args) = @_;
@@ -52,7 +54,7 @@ sub identify_distros {
unless (-d $args->{start_dir} );
croak "Directory $args->{start_dir} must be subdirectory of $self->{id_dir}"
unless ( $args->{start_dir} =~ m/$self->{id_dir}/ );
- $self->{start_dir} = $args->{start_dir};;
+ $self->{start_dir} = $args->{start_dir};
}
else {
$self->{start_dir} = $self->{minicpan};
@@ -133,22 +135,76 @@ sub get_list_ref {
return $self->{list};
}
-# $refreshed_list_ref = $self->refresh_list();
-# $self->identify_distros( { list => $refreshed_list_ref } );
-
sub refresh_list {
- my ($self) = @_;
- # return undef if called no list previously created
- return unless defined $self->{list};
- # store old list for future recall
- $self->{old_list} = $self->{list};
- # we'll need to get list of all distros from presumably updated minicpan
- # and store in hash.
- # we'll then need to iterate over list and replace values for any distros
- # that have upped their version numbers
- my @refreshed_list;
-
- return \@refreshed_list;
+ my ($self, $args) = @_;
+ croak "Need 'derived_list' whose value is list of distributions needing refreshment"
+ unless exists $args->{derived_list};
+ croak "Value of 'derived_list' must be array reference"
+ unless reftype( $args->{derived_list} ) eq 'ARRAY';
+
+ # Call identify_distros() with all arguments except 'derived_list',
+ # i.e., with 'start_dir' and/or 'pattern'.
+ my %reduced_args = map { $_ => 1 } @{ $args->{derived_list} };
+ delete $reduced_args{derived_list};
+ my $rv = $self->identify_distros( \%reduced_args );
+
+ # So now we have an updated primary list ($self->{list}).
+ # We will need to make a hash out of that where they key is the stem of
+ # the distribution name and the value is the version.
+ # We will make a similar hash from the derived list.
+
+ my (%primary, %derived);
+
+ foreach my $distro ( $self->get_list() ) {
+ my $dir = dirname($distro);
+ my $base = basename($distro);
+ if ($base =~ m/^(.*)-([\d\.]+)(?:$ARCHIVE_REGEX)/) {
+ my ($stem, $version) = ($1,$2);
+ my $k = File::Spec->catfile($dir, $stem);
+ $primary{$k} = {
+ distro => $distro,
+ version => normalize_version_number($version),
+ };
+ }
+ else {
+ # Since we don't have any authoritative way to compare version
+ # numbers that can't be normalized, we will (for now) pass over
+ # distributions with non-standard version numbers.
+ }
+ }
+
+ foreach my $distro ( @{ $args->{derived_list} } ) {
+ my $dir = dirname($distro);
+ my $base = basename($distro);
+ if ($base =~ m/^(.*)-([\d\.]+)(?:$ARCHIVE_REGEX)/) {
+ my ($stem, $version) = ($1,$2);
+ my $k = File::Spec->catfile($dir, $stem);
+ $derived{$k} = {
+ distro => $distro,
+ version => normalize_version_number($version),
+ };
+ }
+ else {
+ # Since we don't have any authoritative way to compare version
+ # numbers that can't be normalized, we will (for now) pass over
+ # distributions with non-standard version numbers.
+ }
+ }
+
+ foreach my $stem ( keys %derived ) {
+ if ( not exists $primary{$stem} ) {
+ delete $derived{$stem};
+ }
+ elsif ( $primary{$stem}{version} > $derived{$stem}{version} ) {
+ $derived{$stem}{version} = $primary{$stem}{version};
+ $derived{$stem}{distro} = $primary{$stem}{distro};
+ }
+ else {
+ # nothing to do
+ }
+ }
+
+ return [ sort map { $derived{$_}{distro} } keys %derived ];
}
1;
View
10 lib/CPAN/Mini/Visit/Simple.pod
@@ -288,9 +288,13 @@ hence from your minicpan.
=item * Arguments
- $refreshed_list_ref = $self->refresh_list();
-
- $self->identify_distros( { list => $refreshed_list_ref } );
+ $refreshed_list_ref = $self->refresh_list( {
+ derived_list => \@derived_list,
+ # Next two are optional, but should be used if they were
+ # used to calculate the primary list.
+ start_dir => "$minicpan_id_dir/D/DR/DROLSKY",
+ pattern => qr/Moose/,
+ } );
=item * Return Value
View
51 t/006_refresh_list.t
@@ -12,9 +12,10 @@ use Test::More qw(no_plan); # tests => 26;
#use Data::Dumper;$Data::Dumper::Indent=1;
my ( $self, @list, $tdir, $id_dir, $author_dir );
-my ( @source_list, $output_list_ref, $refreshed_list_ref );
+my ( @source_list, $old_primary_list_ref, $refreshed_list_ref );
{
+ # Prepare the test by creating a minicpan in a temporary directory.
$tdir = tempdir();
$id_dir = File::Spec->catdir($tdir, qw/authors id/);
make_path($id_dir, { mode => 0711 });
@@ -24,9 +25,9 @@ my ( @source_list, $output_list_ref, $refreshed_list_ref );
ok( -d $author_dir, "'author's directory created for testing" );
@source_list = qw(
- Alpha-Beta-0.01-tar.gz
- Gamma-Delta-0.02-tar.gz
- Epsilon-Zeta-0.03-tar.gz
+ Alpha-Beta-0.01.tar.gz
+ Gamma-Delta-0.02.tar.gz
+ Epsilon-Zeta-0.03.tar.gz
);
foreach my $distro (@source_list) {
my $fulldistro = File::Spec->catfile($author_dir, $distro);
@@ -37,6 +38,7 @@ my ( @source_list, $output_list_ref, $refreshed_list_ref );
ok( ( -f $fulldistro ), "$fulldistro created" );
}
+ # Create object and get primary list
$self = CPAN::Mini::Visit::Simple->new({
minicpan => $tdir,
});
@@ -45,13 +47,14 @@ my ( @source_list, $output_list_ref, $refreshed_list_ref );
ok( $self->identify_distros(),
"identify_distros() returned true value" );
- $output_list_ref = $self->get_list_ref();
+ $old_primary_list_ref = $self->get_list_ref();
- my $remove = q{Epsilon-Zeta-0.03-tar.gz};
+ # Bump up the version number of one distro in the minicpan
+ my $remove = q{Epsilon-Zeta-0.03.tar.gz};
my $removed_file = File::Spec->catfile($author_dir, $remove);
is( unlink($removed_file), 1, "$removed_file deleted" );
- my $update = q{Epsilon-Zeta-0.04-tar.gz};
+ my $update = q{Epsilon-Zeta-0.04.tar.gz};
my $updated_file = File::Spec->catfile($author_dir, $update);
open my $FH, '>', $updated_file
or croak "Unable to open handle to $update for writing";
@@ -59,18 +62,34 @@ my ( @source_list, $output_list_ref, $refreshed_list_ref );
close $FH or croak "Unable to close handle to $update after writing";
ok( ( -f $updated_file ), "$updated_file created" );
- # We have now changed what is in our minicpan repository
- # but we have not yet changed our list of selected distros.
- # We need to refresh that list. Then we will compare it to @output_list.
+ # We have now changed what is in our minicpan repository.
+ # We need to refresh what is in $old_primary_list_ref.
+ # (Since we did not use 'start_dir' or 'pattern' to create the old primary
+ # list, we will not provide those arguments to refresh_list().
- $refreshed_list_ref = $self->refresh_list();
+ $refreshed_list_ref = $self->refresh_list( {
+ derived_list => $old_primary_list_ref,
+ } );
- TODO: {
- local $TODO = "Code not written";
+ my $expected_list_ref = {
+ map { my $path = qq|$author_dir/$_|; $path => 1 } qw(
+ Alpha-Beta-0.01.tar.gz
+ Gamma-Delta-0.02.tar.gz
+ Epsilon-Zeta-0.04.tar.gz
+ )
+ };
+ is_deeply(
+ { map { $_ => 1 } @{$refreshed_list_ref} },
+ $expected_list_ref,
+ "Got expected refreshed list"
+ );
- eval { $self->identify_distros_from_derived_list( { list => $refreshed_list_ref } ) };
- is($@, q{}, "No error code found");
+# TODO: {
+# local $TODO = "Code not written";
+#
+# eval { $self->identify_distros_from_derived_list( { list => $refreshed_list_ref } ) };
+# is($@, q{}, "No error code found");
# ok( $self->identify_distros_from_derived_list( { list => $refreshed_list_ref } ),
# "identify_distros_from_derived_list() returned true value" );
- }
+# }
}
Please sign in to comment.
Something went wrong with that request. Please try again.