Permalink
Browse files

1. Update Todo.

2.  Move Simple::_get_lookup_table to Simple::Auxiliary::get_lookup_table.
Change it from taking an array and returning a hash to taking an array ref and
returning a hash ref.  Document it.
  • Loading branch information...
1 parent d1c52e9 commit 38897c77a6a114da3a1f87650082cba7f4342c92 @jkeenan committed Feb 22, 2010
Showing with 107 additions and 35 deletions.
  1. +3 −2 Todo
  2. +10 −32 lib/CPAN/Mini/Visit/Simple.pm
  3. +55 −0 lib/CPAN/Mini/Visit/Simple/Auxiliary.pm
  4. +39 −1 t/006_refresh_list.t
View
5 Todo
@@ -1,5 +1,6 @@
TODO list for Perl module CPAN::Mini::Visit::Simple
-Almost everything! Constructor is incomplete; no other methods yet written.
-
+1. Testing: Write tests for a few uncovered statements and branches in the
+two .pm files. Explicit tests for get_lookup_table().
+2. Development: Write visit method.
@@ -15,6 +15,7 @@ use Scalar::Util qw/ reftype /;
use CPAN::Mini::Visit::Simple::Auxiliary qw(
$ARCHIVE_REGEX
dedupe_superseded
+ get_lookup_table
normalize_version_number
);
#use Data::Dumper;$Data::Dumper::Indent=1;
@@ -153,46 +154,23 @@ sub refresh_list {
# the distribution name and the value is the version.
# We will make a similar hash from the derived list.
- my %primary = _get_lookup_table( $self->get_list() );
- my %derived = _get_lookup_table( @{ $args->{derived_list} } );
+ my $primary = get_lookup_table( $self->get_list_ref() );
+ my $derived = get_lookup_table( $args->{derived_list} );
- foreach my $stem ( keys %derived ) {
- if ( not exists $primary{$stem} ) {
- delete $derived{$stem};
+ 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};
+ 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 ];
-}
-
-sub _get_lookup_table {
- my @distributions = @_;
- my %lookup_table = ();
- foreach my $distro ( @distributions ) {
- 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);
- $lookup_table{$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.
- }
- }
- return %lookup_table;
+ return [ sort map { $derived->{$_}{distro} } keys %{$derived} ];
}
1;
@@ -6,6 +6,7 @@ our @ISA = qw( Exporter );
our @EXPORT_OK = qw(
$ARCHIVE_REGEX
dedupe_superseded
+ get_lookup_table
normalize_version_number
);
use File::Basename;
@@ -56,6 +57,29 @@ sub dedupe_superseded {
return [ sort @newlist ];
}
+sub get_lookup_table {
+ my $distributions_ref = shift;
+ my %lookup_table = ();
+ foreach my $distro ( @{$distributions_ref} ) {
+ 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);
+ $lookup_table{$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.
+ }
+ }
+ return \%lookup_table;
+}
+
sub normalize_version_number {
my $v = shift;
my @captures = split /\./, $v;
@@ -86,7 +110,10 @@ CPAN::Mini::Visit::Simple::Auxiliary - Helper functions for CPAN::Mini::Visit::S
=head1 SYNOPSIS
use CPAN::Mini::Visit::Simple::Auxiliary qw(
+ $ARCHIVE_REGEX
dedupe_superseded
+ get_lookup_table
+ normalize_version_number
);
=head1 DESCRIPTION
@@ -151,6 +178,34 @@ Reference to an array holding a deduplicated list.
=back
+
+=head2 C<get_lookup_table()>
+
+=over 4
+
+=item * Purpose
+
+Convert a list of distributions into a hash keyed on the stem of the
+distribution name and having values which are corresponding version numbers.
+
+=item * Arguments
+
+ my $primary = get_lookup_table( $self->get_list_ref() );
+
+Array reference.
+
+=item * Return Value
+
+Reference to hash holding lookup table. Elements in that hash will resemble:
+
+ '/home/user/minicpan/author/id/Alpha-Beta' => {
+ version => '0.01',
+ distro => '/home/user/minicpan/author/id/Alpha-Beta.tar.gz',
+ },
+
+=back
+
+
=head2 C<normalize_version_number()>
=over 4
View
@@ -8,7 +8,7 @@ use Carp;
use File::Path qw( make_path );
use File::Spec;
use File::Temp qw( tempfile tempdir );
-use Test::More tests => 30;
+use Test::More tests => 39;
{
my ($tdir, $author_dir) = create_minicpan_for_testing();
@@ -81,6 +81,44 @@ use Test::More tests => 30;
"Got expected error message due to bad 'derived_list' argument");
}
+{
+ my ($tdir, $author_dir) = create_minicpan_for_testing();
+ my $self = CPAN::Mini::Visit::Simple->new({ minicpan => $tdir });
+ isa_ok ($self, 'CPAN::Mini::Visit::Simple');
+ ok( $self->identify_distros(),
+ "identify_distros() returned true value" );
+ my $old_primary_list_ref = $self->get_list_ref();
+
+ # Create a stray item in the derived_list. Since it is not found in the
+ # minicpan, it should not be included in the list generated by the
+ # operation of refresh_list().
+
+ my $update = q{Eta-Theta-0.05.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";
+ say $FH q{};
+ close $FH or croak "Unable to close handle to $update after writing";
+ ok( ( -f $updated_file ), "$updated_file created" );
+
+ my $refreshed_list_ref = $self->refresh_list( {
+ derived_list => $old_primary_list_ref,
+ } );
+
+ 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.03.tar.gz
+ )
+ };
+ is_deeply(
+ { map { $_ => 1 } @{$refreshed_list_ref} },
+ $expected_list_ref,
+ "Got expected refreshed list"
+ );
+}
+
sub create_minicpan_for_testing {
my ( $tdir, $id_dir, $author_dir );
my ( @source_list );

0 comments on commit 38897c7

Please sign in to comment.