Portable::Dist - Modify a Perl distribution to make it portable

package Portable::Dist;

use 5.008;
use strict;
use Carp                 ();
use Tie::Slurp           ();
use File::Spec           ();
use File::Path           ();
use File::Slurp          ();
use File::Find::Rule     ();
use File::IgnoreReadonly ();
use Params::Util         '_STRING'; 

our $VERSION = '0.03';

use constant MSWin32 => ( $^O eq 'MSWin32' );

use Object::Tiny qw{
	perl_root
	perl_bin
	perl_lib
	perl_sitelib
	pl2bat
	config_pm
	cpan_config
	file_homedir
	minicpan_dir
	minicpan_conf
};





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

sub new {
	my $self = shift->SUPER::new(@_);

	# Check params
	unless ( _DIRECTORY($self->perl_root) ) {
		Carp::croak("Missing or invalid perl_root directory");
	}

	$self->{perl_bin} ||= File::Spec->catdir( $self->perl_root, 'bin' );
	unless ( _DIRECTORY($self->perl_bin) ) {
		Carp::croak("Missing or invalid perl_bin directory");
	}

	$self->{perl_lib} ||= File::Spec->catdir( $self->perl_root, 'lib' );
	unless ( _DIRECTORY($self->perl_lib) ) {
		Carp::croak("Missing or invalid perl_lib directory");
	}

	$self->{perl_sitelib} ||= File::Spec->catdir( $self->perl_root, 'site', 'lib' );
	unless ( _DIRECTORY($self->perl_sitelib) ) {
		Carp::croak("Missing or invalid perl_sitelib directory");
	}

	# Find some particular files
	$self->{pl2bat}        = File::Spec->catfile( $self->perl_bin,     'pl2bat.bat'         );
	$self->{config_pm}     = File::Spec->catfile( $self->perl_lib,     'Config.pm'          );
	$self->{cpan_config}   = File::Spec->catfile( $self->perl_lib,     'CPAN', 'Config.pm'  );
	$self->{file_homedir}  = File::Spec->catfile( $self->perl_sitelib, 'File', 'HomeDir.pm' );
	$self->{minicpan_dir}  = File::Spec->catfile( $self->perl_sitelib, 'CPAN'               );
	$self->{minicpan_conf} = File::Spec->catfile( $self->minicpan_dir, 'minicpan.conf'      );

	return $self;
}

sub run {
	my $self = shift;

	# Modify the files we need to hack
	$self->modify_config;
	$self->modify_cpan_config;
	$self->modify_file_homedir;

	# Create the minicpan configuration file
	$self->create_minicpan_conf;

	# Convert all existing batch files to portable
	$self->modify_batch_files;

	# Modify pl2bat so new batch files get created properly
	$self->modify_pl2bat;

	return 1;
}





#####################################################################
# Modification Functions

# Apply modifications to Config.pm
sub modify_config {
	my $self   = shift;
	my $file   = $self->config_pm;
	my $append = <<'END_PERL';
eval {
	require Portable;
	Portable->import('Config');
};

1;
END_PERL

	# Apply the change to the file
	my $guard = File::IgnoreReadonly->new( $file );
	tie my $content, 'Tie::Slurp', $file or die "Couldn't read $file";
	$content .= $append;
	untie $content;

	return 1;	
}

# Apply modifications to CPAN::Config
sub modify_cpan_config {
	my $self   = shift;
	my $file   = $self->cpan_config;
	my $append = <<'END_PERL';
eval {
	require Portable;
	Portable->import('CPAN');
};
END_PERL

	# Apply the change to the file
	my $guard = File::IgnoreReadonly->new( $file );
	tie my $content, 'Tie::Slurp', $file or die "Couldn't read $file";
	$content =~ s/\n1;/$append\n\n1;/;
	untie $content;

	return 1;
}

# Apply modifications to File::HomeDir
sub modify_file_homedir {
	my $self   = shift;
	my $file   = $self->file_homedir;
	my $append = <<'END_PERL';
eval {
	require Portable;
	Portable->import('HomeDir');
};
END_PERL

	# Apply the change to the file
	my $guard = File::IgnoreReadonly->new( $file );
	tie my $content, 'Tie::Slurp', $file or die "Couldn't read $file";
	$content =~ s/\n1;/$append\n\n1;/;
	untie $content;

	return 1;
}

# Create the minicpan configuration file
sub create_minicpan_conf {
	my $self = shift;
	my $dir  = $self->minicpan_dir;
	my $file = $self->minicpan_conf;

	# Create the directory
	File::Path::mkpath( $dir, { verbose => 0 } );

	# Write the file
	File::Slurp::write_file(
		$file,
		"class: CPAN::Mini::Portable\n",
		"skip_perl: 1\n",
		"no_conn_cache: 1\n",
	);

	# Make the file readonly
	if ( MSWin32 ) {
		require Win32::File::Object;
		Win32::File::Object->new( $file, 1 )->readonly(1);
	} else {
		require File::chmod;
		File::chmod::chmod( 'a-w', $file );
	}

	return 1;
}

# Modify existing batch files
sub modify_batch_files {
	my $self  = shift;
	my $dir   = $self->perl_bin;
	my @files = File::Find::Rule->name('*.bat')->file->in( $dir );
	unless ( @files ) {
		Carp::croak("Failed to find any batch files");
	}

	# Process the files
	my $prepend = '"%~dp0perl.exe"';
	foreach my $file ( @files ) {
		# Apply the change to the file
		my $guard = File::IgnoreReadonly->new( $file );
		tie my $content, 'Tie::Slurp', $file or die "Couldn't read $file";
		$content =~ s/\nperl -x/\n${prepend} -x/g;
		untie $content;
	}

	return 1;
}

sub modify_pl2bat {
	my $self    = shift;
	my $file    = $self->pl2bat;
	my $prepend = '"%~dp0perl.exe"';
	my $append  = <<'END_PERL';
eval {
	require Portable;
	Portable->import('HomeDir');
};
END_PERL

	# Apply the change to the file
	my $guard   = File::IgnoreReadonly->new( $file );
	tie my $content, 'Tie::Slurp', $file or die "Couldn't read $file";
	$content =~ s/\bperl \$/${prepend} \$/g;
	untie $content;

	return 1;
}





#####################################################################
# Support Functions

sub _DIRECTORY {
	(defined _STRING($_[0]) and -d $_[0]) ? $_[0] : undef;
}

1;