The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package App::DuckPAN::Perl;
BEGIN {
  $App::DuckPAN::Perl::AUTHORITY = 'cpan:DDG';
}
# ABSTRACT: Perl related functionality for duckpan
$App::DuckPAN::Perl::VERSION = '0.156';
use Moo;
with 'App::DuckPAN::HasApp';

use Config::INI;
use Dist::Zilla::Util;
use Path::Class;
use Config::INI::Reader;
use Config::INI::Writer;
use Data::Dumper;
use LWP::Simple;
use List::Util qw/ first /;
use File::Temp qw/ :POSIX /;
use version;
use Parse::CPAN::Packages::Fast;
use Class::Load ':all';

sub dzil_root { Dist::Zilla::Util->_global_config_root }
sub dzil_config { file(shift->dzil_root,'config.ini') }

sub setup {
	my ( $self, %params ) = @_;
	my $config_root = Dist::Zilla::Util->_global_config_root;
	my $config = $self->get_dzil_config;
	$config = {} unless $config;
	$config->{'%Rights'} = {
		license_class => 'Perl_5',
		copyright_holder => $params{name},
	} unless defined $config->{'%Rights'};
	$config->{'%User'} = {
		email => $params{email},
		name => $params{name},
	} unless defined $config->{'%User'};
	$config->{'%DUKGO'} = {
		username => $params{user},
		password => $params{pass},
	};
	$self->set_dzil_config($config);
}

sub get_local_version {
	my ( $self, $module ) = @_;
	require Module::Data;
	my $v;
	{
		local $@;
		eval {
			my $m = Module::Data->new( $module );
			$m->require;
			$v = $m->version;
			1
		} or return;
	};
	return unless defined $v;
	return version->parse($v) unless ref $v;
	return $v;
}

sub cpanminus_install_error {
	shift->app->print_text(
		"[ERROR] Failure on installation of modules!",
        "There are several possible explanations and fixes for this error:",
        "1. The download from CPAN was unsuccessful - Please restart this installer.",
        "2. Some other error occured - Please read the `build.log` mentioned in the errors and see if you can fix the problem yourself.",
        "If you are unable to solve the problem, please let us know by making a GitHub Issue in the DuckPAN Repo:",
        "https://github.com/duckduckgo/p5-app-duckpan/issues",
        "Make sure to attach the `build.log` file if it exists. Otherwise, copy/paste the output you see."
	);
	exit 1;	
}

sub duckpan_install {
	my ( $self, @modules ) = @_;
	my $mirror = $self->app->duckpan;
	my $force_install;
	if ($modules[0] eq 'force') {
		# We sent in a signal to force installation
		$force_install = 1;
		shift @modules;
	}
	my $modules_string = join(' ',@modules);
	my $tempfile = tmpnam;
	if (is_success(getstore($self->app->duckpan_packages,$tempfile))) {
		my $packages = Parse::CPAN::Packages::Fast->new($tempfile);
		my @to_install;
		my $error = 0;
		for (@modules) {
			my $module = $packages->package($_);
			if ($module) {
				local $@;

				# see if we have an env variable for this module
				my $sp = $_;
				$sp =~ s/\:\:/_/g;

				# special case: check for a pinned verison number
				my $pin_version = $ENV{$sp};
				my $localver = $self->get_local_version($_);
				my $duckpan_module_version = version->parse($module->version);
				my $duckpan_module_url = $self->app->duckpan.'authors/id/'.$module->distribution->pathname;

				my $install_it;
				if ($force_install) {
					$install_it = 1;
				} elsif ($pin_version && $localver) {
					print "$_: $localver installed, $pin_version pin, $duckpan_module_version latest\n";
					if ($pin_version > $localver && $duckpan_module_version > $localver && $duckpan_module_version <= $pin_version) {
						$install_it = 1;
					}
				} elsif ($localver && $localver == $duckpan_module_version) {
					$self->app->print_text("You already have latest version of ".$_." with ".$localver."\n");
				} elsif ($localver && $localver > $duckpan_module_version) {
					$self->app->print_text("You have a newer version of ".$_." with ".$localver." (duckpan has ".$duckpan_module_version.")\n");
				} else {
					$install_it = 1;
				}
				push @to_install, $duckpan_module_url if ($install_it && !(first { $_ eq $duckpan_module_url } @to_install));
			} else {
				$self->app->print_text("[ERROR] Can't find package ".$_." on ".$self->app->duckpan."\n");
				$error = 1;
			}
		}
		return 1 if $error;
		return 0 unless @to_install;
		unshift @to_install,'-f'  if ($force_install); # cpanm will do the actual forcing.
		return system("cpanm ".join(" ",@to_install));
	} else {
		$self->app->print_text("[ERROR] Can't reach duckpan at ".$self->app->duckpan."!\n");
		return 1;
	}
}

sub set_dzil_config {
	my ( $self, $config ) = @_;
	$self->dzil_root->mkpath unless -d $self->dzil_root;
	Config::INI::Writer->write_file($config,$self->dzil_config);
}

sub get_dzil_config {
	my ( $self ) = @_;
	return unless -d $self->dzil_root && -f $self->dzil_config;
	Config::INI::Reader->read_file($self->dzil_config);
}

1;

__END__

=pod

=head1 NAME

App::DuckPAN::Perl - Perl related functionality for duckpan

=head1 VERSION

version 0.156

=head1 AUTHOR

Torsten Raudssus <torsten@raudss.us> L<https://raudss.us/>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by DuckDuckGo, Inc. L<https://duckduckgo.com/>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut