view release on metacpan or  search on metacpan

lib/App/DuckPAN.pm  view on Meta::CPAN

				/(opensourceduckduckgo)$/i ||
				/^(goodie)$/i || /^(spice)$/i || /^(fathead)$/i || /^(longtail)$/i ||
				/^ddgc?::/i ||
				/^app/i) {
				my $m = lc $1;

				if($m eq 'goodie' or $m eq 'spice' or $m eq 'fathead' or $m eq 'longtail'){
					$_ = 'DDG::' . ucfirst($m) . 'Bundle::OpenSourceDuckDuckGo';
					$m = 'opensourceduckduckgo';
				}

				if($m eq 'opensourceduckduckgo' && !$ddg){
					unshift @modules, 'DDG';
					$ddg = 1;
				}
				elsif($m eq 'ddg' && $ddg){ next }
				push @modules, $_;
			}
			elsif (m/^duckpan|update|(upgrade|(reinstall|latest))$/i) {
				my ($all_modules, $reinstall_latest) = map { lc } ($1, $2);
				$self->empty_cache unless $self->empty;
				push @modules, 'App::DuckPAN';
				if($all_modules){
					push @modules, 'DDG';
					unshift @modules, $reinstall_latest if $reinstall_latest;
				}
			}
			else {
				push @left_args, $_;
			}
		}
		exit $self->perl->duckpan_install(@modules) unless @left_args;
	}
	$self->emit_and_exit(0, "Unknown command. Use `duckpan help` to see the list of available DuckPAN commands.");
}

has standard_prefix_width => (
	is      => 'ro',
	default => sub { 9 },
);

sub _output_prefix {
	my ($self, $word, $color) = @_;

	my $extra_spaces = max(0, $self->standard_prefix_width - length($word) - 2 ); # 2 []s to be added.

	my $full_prefix = '[' . uc $word . ']' . (' ' x $extra_spaces);

	return ($self->colors) ? colored($full_prefix, $color) : $full_prefix;
}

sub emit_info {
	my ($self, @msg) = @_;

	$self->_print_msg(*STDOUT, '', @msg);
}

sub emit_error {
	my ($self, @msg) = @_;

	state $prefix = $self->_output_prefix('ERROR', 'red bold');

	$self->_print_msg(*STDERR, $prefix, @msg);
}

sub emit_and_exit {
	my ($self, $exit_code, @msg) = @_;

	state $prefix = $self->_output_prefix('FATAL', 'bright_red bold');

	if ($exit_code == 0) {      # This is just an info message.
		$self->emit_info(@msg);
	}
	else {                    # But if it's an unhappy exit
		$self->_print_msg(*STDERR, $prefix, @msg);
	}

	exit $exit_code;
}

sub emit_debug {
	my ($self, @msg) = @_;

	return unless $self->verbose;    # only show messages in verbose mode.

	return $self->_print_msg(*STDOUT, '', @msg);
}

sub emit_notice {
	my ($self, @msg) = @_;

	state $prefix = $self->_output_prefix('NOTICE', 'yellow bold');

	$self->_print_msg(*STDOUT, $prefix, @msg);
}

sub _print_msg {
	my ($self, $fh, $prefix, @lines) = @_;

	foreach my $line (map { $prefix . $_ } grep { $_ } @lines) {
		print $fh $line . "\n";
	}
}

sub camel_to_underscore {
	my ($self, $name) = @_;
	# Replace first capital by lowercase
	# if followed my lowercase.
	$name =~ s/^([A-Z])([a-z])/lc($1).$2/ge;
	# Substitute camelCase to camel_case
	$name =~ s/([a-z])([A-Z])/$1.'_'.lc($2)/ge;
	return lc $name;
}

sub phrase_to_camel {
	my ($self, $phrase) = @_;
	my $camel = $phrase;

	$camel =~ s/
		(?:           # if a character:
			  \s+     # - follows spaces
			| (?<=::) # - or follows ::
			| ^       # - or is the first character
		)(.)          # (the character)
		/\U$1/gx;     # then uppercase it (preceding spaces are removed)

	# remove trailing spaces
	$camel =~ s/\s+$//;

	return $camel;
}

# Normalize an Instant Answer name to a standard form.
# Returns undef if an IA matching the given name cannot be found.
sub get_ia_by_name {
	my ($self, $name) = @_;
	my $ia;

	if ($name =~ /^DDG::/) {
		$ia = DDG::Meta::Data->get_ia(module => $name);
		$ia = $ia->[0] if $ia;
	}
	else {
		$ia = $name =~ /_/
			? DDG::Meta::Data->get_ia(id => $name)
			: DDG::Meta::Data->get_ia(id => $self->camel_to_underscore($name));
	}

	return $ia;
}

sub check_requirements {