Permalink
Browse files

1. Create identify_distros_from_prepared_list() by extracting

'list'-argument-related code from identify_distros().  Test and document.
2.  Refactor code into _search_from_start_dir().
3.  Begin to write method refresh_list() and its documentation.  Create
t/006_refresh_list.t to test it.  (Incomplete; TODO.)
4.  Change $archive_re to $ARCHIVE_REGEX; place it in Auxiliary.pm and export
it so that we only define it in one location.
  • Loading branch information...
1 parent 7b1b234 commit b72c506d48b14f2f9effbabddb4e0c3730e34ec0 @jkeenan committed Feb 21, 2010
View
@@ -12,4 +12,5 @@ t/002_identify_distros.t
t/003_dedupe_superseded.t
t/004_normalize_version_number.t
t/005_get_list.t
+t/006_refresh_list.t
Todo
@@ -12,8 +12,10 @@ use File::Find;
use File::Spec;
use Scalar::Util qw/ reftype /;
use CPAN::Mini::Visit::Simple::Auxiliary qw(
+ $ARCHIVE_REGEX
dedupe_superseded
);
+use Data::Dumper;$Data::Dumper::Indent=1;
sub new {
my ($class, $args) = @_;
@@ -39,17 +41,27 @@ sub new {
return $self;
}
+sub identify_distros_from_prepared_list {
+ my ($self, $args) = @_;
+ croak "Bad argument 'start_dir' provided to identify_distros_from_prepared_list()"
+ if exists $args->{start_dir};
+ croak "Bad argument 'pattern' provided to identify_distros_from_prepared_list()"
+ if exists $args->{pattern};
+ croak "identify_distros_from_prepared_list() needs 'list' element"
+ unless exists $args->{list};
+ croak "Value of 'list' must be array reference"
+ unless reftype($args->{list}) eq 'ARRAY';
+ croak "Value of 'list' must be non-empty"
+ unless scalar(@{$args->{list}});
+ $self->{list} = dedupe_superseded( $args->{list} );
+ return 1;
+}
+
sub identify_distros {
my ($self, $args) = @_;
- if ( exists $args->{list} ) {
- croak "Value of 'list' must be array reference"
- unless reftype($args->{list}) eq 'ARRAY';
- croak "Value of 'list' must be non-empty"
- unless scalar(@{$args->{list}});
- $self->{list} = dedupe_superseded( $args->{list} );
- return 1;
- }
+ croak "Bad argument 'list' provided to identify_distros()"
+ if exists $args->{list};
if ( defined $args->{start_dir} ) {
croak "Directory $args->{start_dir} not found"
@@ -67,15 +79,21 @@ sub identify_distros {
unless (reftype($args->{pattern}) eq 'SCALAR');
}
- my $archive_re = qr{\.(?:tar\.(?:bz2|gz|Z)|t(?:gz|bz)|zip\.gz)$}i;
+ my $found_ref = $self->_search_from_start_dir( $args );
+ $self->{list} = dedupe_superseded( $found_ref );
+ return 1;
+}
+
+sub _search_from_start_dir {
+ my ($self, $args) = @_;
my @found = ();
find(
{
follow => 0,
no_chdir => 1,
preprocess => sub { my @files = sort @_; return @files },
wanted => sub {
- return unless /$archive_re/;
+ return unless /$ARCHIVE_REGEX/;
if ( defined $args->{pattern} ) {
return unless $_ =~ m/$args->{pattern}/;
}
@@ -84,8 +102,7 @@ sub identify_distros {
},
$self->{start_dir},
);
- $self->{list} = dedupe_superseded( \@found );
- return 1;
+ return \@found;
}
sub say_list {
@@ -116,5 +133,22 @@ 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;
+}
1;
@@ -221,6 +221,42 @@ elements in the list underneath the reference returned cannot be guaranteed.
=back
+=head2 C<refresh_list()>
+
+=over 4
+
+=item * Purpose
+
+Takes a previously created list of distributions and replaces elements with
+the most recent versions of those distributions as needed.
+
+Suppose that you have a list of distributions, created originally from your
+minicpan repository, that you are using to test some new CPAN-wide
+functionality. Suppose further that you update your minicpan repository with
+the F<minicpan> utility while still working on your project. You will
+probably want to make sure that you are I<testing against HEAD>, so to speak.
+
+C<refresh_list()> will replace any elements in your list if updated versions
+thereof have appeared in your minicpan. It will also delete any elements if
+their corresponding distributions have been removed entirely from CPAN and
+hence from your minicpan.
+
+=item * Arguments
+
+ $refreshed_list_ref = $self->refresh_list();
+
+ $self->identify_distros( { list => $refreshed_list_ref } );
+
+=item * Return Value
+
+Returns an reference to an array holding the refreshed list. This arrayref is
+suitable for use as the value of the C<list> element in the hashref passed to
+the next call of C<identify_distros()>.
+
+=back
+
+=cut
+
=head1 BUGS
Report bugs at
@@ -4,21 +4,28 @@ use strict;
use warnings;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw(
+ $ARCHIVE_REGEX
dedupe_superseded
normalize_version_number
);
use File::Basename;
use File::Spec;
use Scalar::Util qw( looks_like_number );
+our $ARCHIVE_REGEX = qr{\.(
+ ?:tar\.(?:bz2|gz|Z) |
+ t(?:gz|bz) |
+ zip |
+ gz
+)$}ix;
+
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)/) {
+ if ($base =~ m/^(.*)-([\d\.]+)(?:$ARCHIVE_REGEX)/) {
my ($stem, $version) = ($1,$2);
my $k = File::Spec->catfile($dir, $stem);
if ( not $version_seen{$k}{version} ) {
View
@@ -2,11 +2,13 @@
# t/001_new.t
+use 5.010;
use Carp;
use File::Path qw( make_path );
use File::Spec;
use File::Temp qw( tempdir );
-use Test::More tests => 5;
+use Test::More qw(no_plan); # tests => 5;
+use Data::Dumper;$Data::Dumper::Indent=1;
BEGIN { use_ok( 'CPAN::Mini::Visit::Simple' ); }
@@ -39,3 +41,31 @@ like($@, qr/Directory $phony_minicpan not found/,
"Got expected error message for malformed minicpan repository" );
}
+{
+ $tdir = tempdir();
+ $id_dir = File::Spec->catdir($tdir, qw/authors id/);
+ make_path($id_dir, { mode => 0711 });
+ ok( -d $id_dir, "'authors/id' directory created for testing" );
+ $author_dir = File::Spec->catdir($id_dir, qw( A AA AARDVARK ) );
+ make_path($author_dir, { mode => 0711 });
+ ok( -d $author_dir, "'author's directory created for testing" );
+
+ my @source_list = qw(
+ 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);
+ open my $FH, '>', $fulldistro
+ or croak "Unable to open handle to $distro for writing";
+ say $FH q{};
+ close $FH or croak "Unable to close handle to $distro after writing";
+ ok( ( -f $fulldistro ), "$fulldistro created" );
+ }
+
+ $self = CPAN::Mini::Visit::Simple->new({
+ minicpan => $tdir,
+ });
+ isa_ok ($self, 'CPAN::Mini::Visit::Simple');
+}
View
@@ -2,30 +2,31 @@
# t/002_identify_distros.t
+use 5.010;
use CPAN::Mini::Visit::Simple;
use Carp;
use File::Path qw( make_path );
use File::Spec;
use File::Temp qw( tempfile tempdir );
use IO::CaptureOutput qw( capture );
use Tie::File;
-use Test::More tests => 26;
+use Test::More qw(no_plan); # tests => 26;
my ( $self, $rv, @list, $phony_minicpan, $tdir, $id_dir );
$self = CPAN::Mini::Visit::Simple->new({});
isa_ok ($self, 'CPAN::Mini::Visit::Simple');
eval {
- $self->identify_distros({
+ $self->identify_distros_from_prepared_list({
list => {},
});
};
like($@, qr/Value of 'list' must be array reference/,
"Got expected error message for bad 'list' value -- must be array ref" );
eval {
- $self->identify_distros({
+ $self->identify_distros_from_prepared_list({
list => [],
});
};
@@ -39,8 +40,54 @@ like($@, qr/Value of 'list' must be non-empty/,
/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" );
+ eval {
+ $self->identify_distros_from_prepared_list({
+ list => \@list,
+ start_dir => '/foo/bar',
+ });
+ };
+ like($@,
+ qr/Bad argument 'start_dir' provided to identify_distros_from_prepared_list()/,
+ "Got expected error message when calling identify_distros_from_prepared_list() with 'start_dir'" );
+
+ eval {
+ $self->identify_distros_from_prepared_list({
+ list => \@list,
+ pattern => qr/foo\/bar/,
+ });
+ };
+ like($@,
+ qr/Bad argument 'pattern' provided to identify_distros_from_prepared_list()/,
+ "Got expected error message when calling identify_distros_from_prepared_list() with 'pattern'" );
+}
+
+{
+ $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
+ );
+ eval {
+ $self->identify_distros({
+ list => \@list,
+ start_dir => '/foo/bar',
+ });
+ };
+ like($@,
+ qr/Bad argument 'list' provided to identify_distros()/,
+ "Got expected error message when calling identify_distros with 'list'" );
+}
+
+{
+ $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_from_prepared_list({ list => \@list, }),
+ "identify_distros_from_prepared_list() returned true value" );
my ($stdout, $stderr);
capture(
@@ -2,6 +2,7 @@
# t/003_dedupe_superseded.t
+use 5.010;
use CPAN::Mini::Visit::Simple::Auxiliary qw(
dedupe_superseded
);
@@ -2,6 +2,7 @@
# t/004_normalize_version_number.t
+use 5.010;
use CPAN::Mini::Visit::Simple::Auxiliary qw(
normalize_version_number
);
View
@@ -2,6 +2,7 @@
# t/005_get_list.t
+use 5.010;
use CPAN::Mini::Visit::Simple;
use Test::More tests => 6;
@@ -15,7 +16,7 @@ isa_ok ($self, 'CPAN::Mini::Visit::Simple');
/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
);
-$self->identify_distros( { list => \@input_list } );
+$self->identify_distros_from_prepared_list( { list => \@input_list } );
@output_list = $self->get_list();
is_deeply(
Oops, something went wrong.

0 comments on commit b72c506

Please sign in to comment.