File Coverage

blib/lib/MyCPAN/Indexer/CPANMiniInject.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

package MyCPAN::Indexer::CPANMiniInject;
use strict;
use warnings;

use parent qw(MyCPAN::Indexer::Component);
use vars qw($VERSION $logger);
$VERSION = '1.28_12';

use File::Basename;
use File::Spec::Functions qw(catfile);
use Log::Log4perl;
use MyCPAN::Indexer;
use YAML;

=head1 NAME

MyCPAN::Indexer::CPANMiniInject - Do the indexing, and put the dists in a MiniCPAN

=head1 SYNOPSIS

Use this in backpan_indexer.pl by specifying it as the queue class:

	# in backpan_indexer.config
	worker_class  MyCPAN::Indexer::CPANMiniInject

=head1 DESCRIPTION

This class takes a distribution and analyses it. Once it knows the modules
inside the distribution, it adds the distribution to a CPAN::Mini::Inject
staging repository. This portion specifically does not inject the modules
into the MiniCPAN. The injection has to happen after all of the workers
have finished.

=head2 Configuration

=over 4

=item minicpan_inject_config

The location of the configuration file for CPAN::Mini::Config

=back

=cut

=head2 Methods

=over 4

=item get_task( $Notes )

C sets the C key in the C<$Notes> hash reference. The
value is a code reference that takes a distribution path as its only
argument and indexes that distribution.

See L for details about what C expects
and should do.

=cut

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

sub component_type { $_[0]->worker_type }

sub get_task
	{
	my( $self ) = @_;

	my $child_task = sub {
		my $dist = shift;

		my $basename = $self->_check_for_previous_result( $dist );
		return unless $basename;

		my $Config = $self->get_config;

		$logger->info( "Child [$$] processing $dist\n" );

		my $indexer = $self->get_coordinator->get_component( 'indexer' );

		unless( chdir $Config->temp_dir )
			{
			$logger->error( "Could not change to " . $Config->temp_dir . " : $!\n" );
			exit 255;
			}

		local $SIG{ALRM} = sub { die "alarm\n" };
		alarm( $Config->alarm || 15 );
		my $info = eval { $indexer->run( $dist ) };

		unless( defined $info )
			{
			$logger->error( "run failed: $@" );
			return;
			}
		elsif( ! eval { $info->run_info( 'completed' ) } )
			{
			$logger->error( "$basename did not complete\n" );
			$self->_copy_bad_dist( $info ) if $Config->copy_bad_dists;
			}

		alarm 0;

		$self->_add_run_info( $info );

		$self->get_note( 'reporter' )->( $info );

		$logger->debug( "Child [$$] process done" );

		1;
		};

	$self->set_note( 'child_task', $child_task );
	}

sub _copy_bad_dist
	{
	my( $self, $info ) = @_;

	my $config = $self->get_config;

	if( my $bad_dist_dir = $config->copy_bad_dists )
		{
		my $dist_file = $info->dist_info( 'dist_file' );
		my $basename  = $info->dist_info( 'dist_basename' );
		my $new_name  = catfile( $bad_dist_dir, $basename );

		unless( -e $new_name )
			{
			$logger->debug( "Copying bad dist" );

			my( $in, $out );

			unless( open $in, "<", $dist_file )
				{
				$logger->fatal( "Could not open bad dist to $dist_file: $!" );
				return;
				}

			unless( open $out, ">", $new_name )
				{
				$logger->fatal( "Could not copy bad dist to $new_name: $!" );
				return;
				}

			while( <$in> ) { print { $out } $_ }
			close $in;
			close $out;
			}
		}
	}

sub _check_for_previous_result
	{
	my( $self ) = @_;

	my $Config = $self->get_config;

	my $dist = $self->get_dist_info( 'filename' );

	( my $basename = basename( $dist ) ) =~ s/\.(tgz|tar\.gz|zip)$//;

	my $yml_dir        = catfile( $Config->report_dir, "meta"        );
	my $yml_error_dir  = catfile( $Config->report_dir, "meta-errors" );

	my $yml_path       = catfile( $yml_dir,       "$basename.yml" );
	my $yml_error_path = catfile( $yml_error_dir, "$basename.yml" );

	if( my @path = grep { -e } ( $yml_path, $yml_error_path ) )
		{
		$logger->debug( "Found run output for $basename in $path[0]. Skipping...\n" );
		return;
		}

	return $basename;
	}

sub _add_run_info
	{
	my( $self, $info ) = @_;

	my $Config = $self->get_config;

	return unless eval { $info->can( 'set_run_info' ) };

	$info->set_run_info( $_, $Config->get( $_ ) )
		foreach ( $Config->directives );

	$info->set_run_info( 'uuid', $Config->UUID );

	$info->set_run_info( 'child_pid',  $$ );
	$info->set_run_info( 'parent_pid', getppid );

	$info->set_run_info( 'ENV', \%ENV );

	return 1;
	}

=back


=head1 SEE ALSO

MyCPAN::Indexer, MyCPAN::Indexer::Tutorial

=head1 SOURCE AVAILABILITY

This code is in Github:

	git://github.com/briandfoy/mycpan-indexer.git

=head1 AUTHOR

brian d foy, C<<  >>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2008-2013, brian d foy, All Rights Reserved.

You may redistribute this under the same terms as Perl itself.

=cut

1;