#!/usr/bin/env perl
use strict;
use File::Spec::Functions qw( rel2abs catdir catfile no_upwards );

sub uniq { my %seen; grep { not $seen{$_}++ } @_ }

sub get_command_line {
	my $comp = substr $ENV{'COMP_LINE'}, 0, $ENV{'COMP_POINT'};
	return split /[ \t]+/, $comp, -1; # if not good enough, use Text::ParseWords
}

sub slurp_dir {
	opendir my $dir, shift or return;
	no_upwards readdir $dir;
}

sub suggestion_from_name {
	my ( $file_rx, $path, $name ) = @_;
	return if not $name =~ /$file_rx/;
	return $name.'::' if -d catdir $path, $name;
	return $1;
}

sub suggestions_from_path {
	my ( $file_rx, $path ) = @_;
	map { suggestion_from_name $file_rx, $path, $_ } slurp_dir $path;
}

sub get_package_suggestions {
	my ( $pkg ) = @_;

	my @segment = split /::|:\z/, $pkg, -1;
	my $file_rx = qr/\A(${\quotemeta pop @segment}\w*)(?:\.pm|\.pod)?\z/;

	my $home = rel2abs $ENV{'HOME'};
	my $cwd = rel2abs do { require Cwd; Cwd::cwd() };

	my @suggestion =
		map { suggestions_from_path $file_rx, $_ }
		uniq map { catdir $_, @segment }
		grep { $home ne $_ and $cwd ne $_ }
		map { $_, ( catdir $_, 'pod' ) }
		map { rel2abs $_ }
		@INC;

	# fixups
	if ( $pkg eq '' ) {
		my $total = @suggestion;
		@suggestion = grep { not /^perl/ } @suggestion;
		my $num_hidden = $total - @suggestion;
		push @suggestion, "perl* ($num_hidden hidden)" if $num_hidden;
	}
	elsif ( $pkg =~ /(?<!:):\z/ ) {
		@suggestion = map { ":$_" } @suggestion;
	}

	return @suggestion;
}

sub get_function_suggestions {
	my ( $func ) = @_;

	my $perlfunc;
	for ( @INC, undef ) {
		return if not defined;
		$perlfunc = catfile $_, qw( pod perlfunc.pod );
		last if -r $perlfunc;
	}

	open my $fh, '<', $perlfunc or return;

	my @suggestion;
	my $nest_level = -1;
	while ( <$fh> ) {
		next if 1 .. /^=head2 Alphabetical Listing of Perl Functions$/;
		++$nest_level if /^=over/;
		--$nest_level if /^=back/;
		next if $nest_level;
		push @suggestion, /^=item (-?\w+)/;
	}

	my $func_rx = qr/\A${\quotemeta $func}/;

	return grep { /$func_rx/ } @suggestion;
}

sub usage {
	die map "\n$_\n", (
		"To use, issue the following command in bash:",
		"\tcomplete -C perldoc-complete -o nospace -o default perldoc",
		"You probably want to put that line in your ~/.bashrc file.\n",
	);
}

usage() if not exists $ENV{'COMP_LINE'};

my ( $cmd, @arg ) = get_command_line();
my $word = pop @arg;

print "$_\n" for ( @arg and @arg[-1] eq '-f' )
	? get_function_suggestions( $word )
	: get_package_suggestions( $word );
