The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package MyCPAN::App::DPAN::SkipQueue;
use strict;
use warnings;

use base qw(MyCPAN::Indexer::Queue);
use vars qw($VERSION $logger);
$VERSION = '1.281';

use File::Basename;
use File::Find;
use File::Find::Closures qw( find_by_regex );
use File::Path qw(mkpath);
use File::Spec::Functions qw( catfile rel2abs );
use Log::Log4perl;

BEGIN {
	$logger = Log::Log4perl->get_logger( 'Queue' );
	}

=encoding utf8

=head1 NAME

MyCPAN::App::DPAN::Queue - Find distributions to index, possibly skipping some

=head1 SYNOPSIS

Use this from your C<dpan> configuration file by specifying it as the
queue class:

	queue_class  MyCPAN::App::DPAN::SkipQueue
	skip_perl    1

	# not yet implemented
	skip_name   Foo::Bar Bar::Baz
	skip_regex  Foo::.*

=head1 DESCRIPTION

This class returns a list of Perl distributions for the BackPAN
indexer to process.

=head2 Methods

=over 4

=item get_queue

This extends the C<get_queue> method from  C<MyCPAN::Indexer::Queue>
to filter the list of files it returns.

C<get_queue> sets the key C<queue> in C<$Notes> hash reference. It
finds all of the tarballs or zip archives in under the directories
named in C<dpan_dir> and C<merge_dirs> in the configuration.

It specifically skips files that end in C<.txt.gz> or C<.data.gz>
since PAUSE creates those meta files near the actual module
installations.

If the C<organize_dists> configuration value is true, it also copies
any distributions it finds into a PAUSE-like structure using the
value of the C<pause_id> configuration to create the path.

If C<skip_perl> is true, it filters out any distributions matching
C<\bperl->.

=cut

sub _get_file_list
	{
	my( $self, @dirs ) = @_;

	my $files = $self->SUPER::_get_file_list( @dirs );

	$logger->debug( "There are " . @$files . " files in the queue" );

	for( my $i = $#$files; $i >= 0; $i-- )
		{
		splice @$files, $i, 1, ()
			if $self->_basename_matches_skip( $files->[$i] );
		}

	$logger->debug( "After filtering, there are " .
		@$files . " files in the queue" );
	return $files;
	}

sub _basename_matches_skip
	{
	my( $self, $distname ) = @_;

	my $skip_perl = $self->get_coordinator->get_config->get( 'skip_perl' ) || 0;
	my @skip_regexes = grep { defined }
		$self->get_coordinator->get_config->get( 'skip_dists_regexes' );

	my @compiled_regexes = map {
		$logger->debug( "Trying to compile regex [$_]" );
		my $compiled = eval { qr/$_/ };
		$logger->fatal( "Could not compile regex [$_] from skip_dists_regexes: $@" )
			unless ref $compiled eq ref qr//;
		} @skip_regexes;

	push @skip_regexes, qr/^(?:strawberry-)?perl-/ if $skip_perl;

	$logger->debug( "skip_perl is [$skip_perl]" );
	$logger->debug( "skip_dists_regexes is [@skip_regexes]" );

	my $basename = basename( $distname );
	foreach my $regex ( @skip_regexes )
		{
		if( $basename =~ m/$regex/ )
			{
			$logger->debug( "Dist $basename matches $regex" );
			return $regex;
			}
		}

	return 0;
	}

=back

=head1 SEE ALSO

MyCPAN::Indexer::Queue

=head1 SOURCE AVAILABILITY

This code is in Github:

	git://github.com/briandfoy/mycpan-app-dpan.git

=head1 AUTHOR

brian d foy, C<< <bdfoy@cpan.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright © 2010-2018, brian d foy <bdfoy@cpan.org>. All rights reserved.

You may redistribute this under the terms of the Artistic License 2.0.

=cut