view release on metacpan or  search on metacpan

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

package CPAN::Inject;

=pod

=head1 NAME

CPAN::Inject - Base class for injecting distributions into CPAN sources

=head1 SYNOPSIS

  # Create the injector
  my $cpan = CPAN::Inject->new(
      sources => '/root/.cpan/sources',  # Required field
      author  => 'LOCAL',                # The default
      );
  
  # Add a file to the user
  $cpan->add( file => 'some/random/Perl-Tarball-1.02.tar.gz' );
  
  # 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

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

	$_[0]->{author};
}





#####################################################################
# Main methods

=pod

=head2 add

  # Add a file to the constructor/default author
  $cpan->add( file => 'any/arbitrary/Perl-Tarball-1.01.tar.gz' );

The C<add> method takes a Perl distribution tarball from an arbitrary
path, and adds it to the sources path.

The specific location the tarball is copied to will be in the root
directory for the author provided to the constructor.

Returns the install_path value as a convenience, or throws an exception
on error.

=cut

sub add {
	my $self   = shift;
	my %params = @_;

	# Check the file source path
	my $from_file = $params{file};
	unless ( $from_file and -f $from_file and -r $from_file ) {
		Carp::croak("Did not provide a file name, or does not exist");
	}

	# Get the file name
	my $name = File::Basename::fileparse($from_file)
		or die "Failed to get filename";

	# Find the location to copy it to
	my $to_file = $self->file_path($name);
	my $to_dir  = File::Basename::dirname($to_file);

	# Make the path for the file
	SCOPE: {
		local $@;
		eval {
			File::Path::mkpath($to_dir);
		};
		if ( my $e = $@ ) {
			Carp::croak("Failed to create $to_dir: $e");
		}
	}

	# Copy the file to the directory, and ensure writable
	File::Copy::copy( $from_file => $to_file )
		or Carp::croak("Failed to copy $from_file to $to_file");
	chmod( 0644, $to_file )
		or Carp::croak("Failed to correct permissions for $to_file");

	# Update the checksums file, and ensure writable
	SCOPE: {
		local $@;
		eval {
			CPAN::Checksums::updatedir($to_dir);
		};
		if ( my $e = $@ ) {
			Carp::croak("Failed to update CHECKSUMS after insertion: $e");
		}
	}
	chmod( 0644, File::Spec->catfile( $to_dir, 'CHECKSUMS' ) )
		or Carp::croak("Failed to correct permissions for CHECKSUMS");

	# Return the install_path as a convenience
	$self->install_path($name);
}

=pod

=head2 remove

  # Remove a distribution from the repository
  $cpan->remove( dist => 'LOCAL/Perl-Tarball-1.01.tar.gz' );

The C<remove> method takes a distribution path and removes it from the
sources path. The file is also removed.

Does not return anything useful and throws an exception on error.

=cut

sub remove {
	my $self   = shift;
	my %params = @_;

	# Get the file name
	my $name = File::Basename::fileparse($params{dist})
		or die "Failed to get filename";

	my $file_path = $self->file_path($name);

	# Remove the file from CPAN.
	unlink $file_path while -e $file_path;

	# Update the checksums file
	my $to_file = $self->file_path($name);
	my $to_dir  = File::Basename::dirname($to_file);
	SCOPE: {
		local $@;
		eval {
			CPAN::Checksums::updatedir($to_dir);
		};
		if ( my $e = $@ ) {
			Carp::croak("Failed to update CHECKSUMS after removal: $e");
		}
	}

	return 1;
}

=pod

=head2 author_subpath

  # $path = 'authors/id/L/LO/LOCAL'
  $path = $cpan->author_subpath;

The C<author_subpath> method takes a CPAN author id (or uses the CPAN
author id originally provided to the constructor) and returns the
relative subpath for the AUTHOR within the sources tree.