File Coverage

blib/lib/CPAN/YACSmoke/Plugin/Recent.pm

Criterion	Covered	Total	%
statement	53	54	98.1
branch	11	14	78.5
condition	7	14	50.0
subroutine	11	11	100.0
pod	2	2	100.0
total	84	95	88.4

=head1 NAME

CPAN::YACSmoke::Plugin::Recent - Recent list for Yet Another CPAN Smoke Tester

=head1 SYNOPSIS

  use CPAN::YACSmoke;
  my $config = {
      list_from        => 'Recent',
      recent_list_path => '.',       # defaults to CPANPLUS base directory
      recent_list_age  => 1          # max age of file (*)
  };
  my $foo = CPAN::YACSmoke->new(config => $config);
  my @list = $foo->download_list();

  # (*) defaults to always getting a fresh file

=head1 DESCRIPTION

This module provides the backend ability to access the list of current
modules in the F file from a CPAN Mirror.

This module should be used together with L.

=cut

package CPAN::YACSmoke::Plugin::Recent;

use 5.006001;
use strict;
use warnings;

our $VERSION = '0.03';

# -------------------------------------
# Library Modules

use CPAN::YACSmoke;
use LWP::Simple;
use URI;
use Path::Class;
# use File::Spec::Functions qw( catfile );
use IO::File;

# -------------------------------------
# Constants

use constant RECENT_FILE   => 'RECENT';

# -------------------------------------
# The Subs

=head1 CONSTRUCTOR

=over 4

=item new()

Creates the plugin object.

=back

=cut

sub new {
  my $class = shift || __PACKAGE__;
  my $hash  = shift;

  my $self = {
    recent_list_age => 1
  };
  foreach my $field (qw( smoke force recent_list_path recent_list_age )) {
    $self->{$field} = $hash->{$field}   if(exists $hash->{$field});
  }

  bless $self, $class;
}

=head1 METHODS

=over 4

=item download_list()

Return the list of distributions recorded in the latest RECENT file.

=cut

sub download_list {
  my $self  = shift;

  my $path  = $self->{recent_list_path} || $self->{smoke}->basedir();
  my $local = file( $path, RECENT_FILE ); # catfile

  if ((!$self->{force}) && $self->{recent_list_age} &&
      (-e $local) && ((-M $local) < $self->{recent_list_age}) ) {
    # no need to download

  } else {
    my $hosts = $self->{smoke}->{conf}->get_conf('hosts');
    my $h_ind = 0;

    while ($h_ind < @$hosts) {
      my $remote = URI->new( $hosts->[$h_ind]->{scheme} . '://' .
			     $hosts->[$h_ind]->{host} . $hosts->[$h_ind]->{path} . RECENT_FILE );

      #	 $self->{smoke}->msg("Downloading $remote to $local", $self->{smoke}->{verbose});

      my $status = mirror( $remote, $local );
      last    if ($status == RC_OK);
      $h_ind++;
    }

    return ()   if(@$hosts == $h_ind); # no host accessible
  }

  my @testlist;
  my $fh = IO::File->new($local)
    or croak("Cannot access local RECENT file [$local]: $!\n");
  while (<$fh>) {
    next    unless(/^authors/);
    next    unless(/\.(tar\.gz|tgz|tar\.bz2|zip)\n$/);
    s!authors/id/!!;
    chomp;
    # $self->{smoke}->msg("RECENT $_", $self->{smoke}->{debug});
    # print STDERR $_, "\n";
    push @testlist, $_;
  }

  return @testlist;
}

1;
__END__