view release on metacpan or  search on metacpan

lib/CPAN/Inject.pm  view on Meta::CPAN

  # What would have have to use when installing
  # $path = 'LOCAL/Perl-Tarball-1.02.tar.gz';
  my $path = $cpan->install_path( 'some/random/Perl-Tarball-1.02.tar.gz' );

=head1 DESCRIPTION

Following the release of L<CPAN::Mini>, the L<CPAN::Mini::Inject> module
was created to add additional distributions into a minicpan mirror.

While it was created for use with a minicpan mirror, similar
functionality can be reused in other situations.

B<CPAN::Inject> replicates the basics of this functionality.

Specifically, it takes an arbitrary tarball and adds it to the CPAN
sources directory for a particular author, and then add the new file
to the F<CHECKSUMS> file.

It does not reimplement the logic to add files to the indexes.

The initial use this module was created for was to inject tarballs into
the CPAN sources directory for the reserved LOCAL user, so that the can be
installed via the CPAN shell, with automated recursion to CPAN dependencies.

But although the number of functions is limited (current only C<add> exists,
with the others to be added as needed) the implementation is very generic
and sub-classable, so that it can be reused in other situations.

=head1 METHODS

=cut

use 5.006;
use strict;
use Params::Util    ();
use File::stat      ();
use File::chmod     ();
use File::Spec      ();
use File::Path      ();
use File::Copy      ();
use File::Basename  ();
use CPAN::Checksums ();

use vars qw{$VERSION $CHECK_OWNER};

BEGIN {
	$VERSION = '1.14';

	# Attempt to determine whether or not we are capable
	# of finding the owner of a directory.
	# Unless someone set it to a hard-coded value before we
	# started to load this module.
	unless ( defined $CHECK_OWNER ) {
		# Take a directory we know should exist...
		my $root = File::Spec->rootdir();
		unless ( -d $root ) {
			die "Cannot determine if CPAN::Inject can operate on this platform";
		}

		# ... find the owner for it...
		my $owner = File::stat::stat($root)->uid;

		# ... and if it works, check again in the future.
		# Unless someone set it already, in which case
		$CHECK_OWNER = defined $owner ? 1 : '';
	}

	# And boolify the value, just to be a little safer
	$CHECK_OWNER = !! $CHECK_OWNER;
}





#####################################################################
# Constructor and Accessors

=pod

=head2 new

  # Create the injector for the default LOCAL author
  $cpan = CPAN::Inject->new(
      sources => '/root/.cpan/sources',
      );
  
  # Create the injector for a specific author
  $cpan = CPAN::Inject->new(
      sources => '/root/.cpan/sources',
      author  => 'ADAMK',
      );

The C<new> constructor takes a set of named params and create a cpan
injection object.

* B<sources> - The compulsory C<sources> param should be the path to a
directory that is the root of a mirror (or a partial mirror such as a
L<CPAN::Cache> or a L<CPAN::Mini>).

To retain the permissions and ownership integrity of the sources tree,
you must be the owner of the C<sources> directory in order to inject the
distribution tarballs.

* B<author> - The optional C<author> param should be the CPAN id of an
author. By default, the reserved local CPAN id "LOCAL" will be used.

The author provided will be used as a default in all further actions.

Returns a C<CPAN::Inject> object, or throws an exception on error.

=cut

sub new {
	my $class = shift;
	my $self  = bless {@_}, $class;

	# Check where we are going to write to
	my $sources = $self->sources;
	unless ( Params::Util::_STRING($sources) ) {
		Carp::croak("Did not probide a sources param, or not a string");
	}
	unless ( -d $sources ) {
		# The sources directory may actually exist, but we cannot
		# see it because we do not have execute permissions to the
		# parent directory tree.
		# For example, if it is at /root/.cpan/source and we do not
		# have -x permissions to /root
		my ($v, $d) = File::Spec->splitpath( $sources, 'nofile' );
		my @dirs    = File::Spec->splitdir( $d );

		# Ignore the last directory, since that is what we -d tested
		pop @dirs;

		# Check for the existance and rx status of each parent
		foreach my $i ( 0 .. $#dirs ) {
			my $parent = File::Spec->catpath(
				$v,
				File::Spec->catdir( @dirs[0..$i] ),
				'', # No file (returns just the dir)
				);
			unless ( -d $parent ) {
				Carp::croak("The directory '$sources' does not exist");
			}
			unless ( -r $parent and -x $parent ) {
				# Assume that it does exist, but that we can't see it
				Carp::croak("The sources directory is not owned by the current user");
			}
		}
		Carp::croak("The directory '$sources' does not exist");
	}
	unless ( $< == File::stat::stat($sources)->uid ) {
		Carp::croak("The sources directory is not owned by the current user");
	}

	# Check for a default author name
	$self->{author} = 'LOCAL' unless $self->author;
	unless ( _AUTHOR( $self->author ) ) {
		Carp::croak( "The author name '"
			. $self->author
			. "' is not a valid author string"
		);
	}

	$self;
}

=pod

=head2 from_cpan_config

The C<from_cpan_config> constructor loads the CPAN.pm configuration file, and
uses the data contained within to specific the sources path for the
object.

This constructor is otherwise the same.

Returns a B<CPAN::Inject> object on success, or throws an exception on
error.

=cut

sub from_cpan_config {
	my $class = shift;

	# Load the CPAN module
	require CPAN;

	# Support for different mechanisms depending on the version
	# of CPAN that is in use.
	if ( defined $CPAN::HandleConfig::VERSION ) {
		CPAN::HandleConfig->load;
	} else {
		CPAN::Config->load;
	}

	# Get the sources directory
	my $sources = undef;
	if ( defined $CPAN::Config->{keep_source_where} ) {
		$sources = $CPAN::Config->{keep_source_where};
	} elsif ( defined $CPAN::Config->{cpan_home} ) {
		$sources = File::Spec->catdir( $CPAN::Config->{cpan_home}, 'sources' );
	} else {
		Carp::croak("Failed to find sources directory in CPAN::Config");
	}

	# Hand off to the main constructor
	return $class->new(
		sources => $sources,
		@_,
		);
}