#!/usr/bin/env perl

# a simple interface to packages.sabayon.org
# (C) 2011-2012, 2014 by Enlik <poczta-sn at gazeta . pl>
# license: MIT

use warnings;
use strict;
use 5.010;
use IO::Handle;
use Term::ANSIColor;
use List::Util 1.33;
use App::Querypkg;

my $querypkg = App::Querypkg->new;
my $use_colour = (-t STDOUT);
my $quiet_mode = 0;
my $print_details_url = 0;
my $print_download_location = 0;
my @display_prop = (); # what properties to display; all if empty

sub run {
	if (@ARGV) {
		parse_cmdline(@ARGV);
	}
	else {
		interactive_ui();
	}

	unless ($quiet_mode) {
		say str_col("green", ">>  "), str_col("red", "@@ "),
			str_col("green", "Please wait, downloading data...");
	}

	unless ($querypkg->get_data()) {
		say STDERR "Error: ", $querypkg->geterr();
		exit 1;
	}

	while (my $data = $querypkg->next_pkg()) {
		print_package_details ( $data )
	}

	unless ($quiet_mode) {
		say str_col("green",">>")," "x2, str_col("bold blue", "Keyword:  "),
			str_col("magenta",$querypkg->get_keyword());
	}

	if ( $querypkg->limit_reached() ) {
		my $limit = $querypkg->server_results_limit();
		# flush standard output so message below doesn't show in a random place
		STDOUT->flush;
		my $msg = "The number of items sent by the server equals the ";
		$msg .= "server-side limit of $limit.\nIf there are more results, ";
		$msg .= "they were omitted.";
		say STDERR str_col("bold yellow", "\n* "),
			$quiet_mode ? $msg : str_col("bold", $msg);
	}
}

sub parse_cmdline {
	my $params_ok = 1;
	my @unknown_with_hyphen = ();
	my $key;

	my $in = sub {
		my $arg = shift;
		List::Util::any { $_ eq $arg } @_;
	};

	while (my $arg = shift) {
		if ($in->($arg, "--help", "-h")) {
			display_help();
			exit 0;
		}
		elsif ($in->($arg, "--arch",  "--order", "--type", "--repo")) {
			my $param = $arg;
			$param =~ s/^--//;
			$arg = shift;
			my @opts = $querypkg->get_API_array($param, 1);
			if( $in->($arg // "", @opts) ) {
				$querypkg->set_req_params($param => $arg);
			}
			else {
				say STDERR "Wrong parameter after --$param. Correct " ,
					"parameters: ", (join ", ",@opts), ".";
				$params_ok = 0;
			}
		}
		elsif ($arg eq "--show") {
			# "--show ," works as if no --show option provided
			# we don't check for it
			# --show invocations are cumulative (it may change)
			$arg = shift;
			if (defined $arg) {
				for (split ',', $arg) {
					push @display_prop, lc($_) if length $_;
				}
			}
			else {
				say STDERR "No option for --show provided.";
				$params_ok = 0;
				last;
			}
		}
		elsif ($arg eq "--color") {
			$use_colour = 1;
		}
		elsif ($arg eq "--nocolor") {
			$use_colour = 0;
		}
		elsif ($in->($arg, "--quiet", "-q")) {
			$quiet_mode = 1;
		}
		elsif ($arg eq "-u") {
			$print_details_url = 1;
		}
		elsif ($arg eq "-D") {
			$print_download_location = 1;
		}
		else {
			# key
			push @unknown_with_hyphen, $arg if $arg =~ /^-/;
			if (defined $key) {
				say STDERR "* You can specify only one keyword (at: $arg).";
				$params_ok = 0;
				#last;
			}
			else {
				$key = $arg;
			}
		}
	}

	if ($print_download_location) {
		# colour options are ignored silently
		if ( @display_prop or $quiet_mode or $print_details_url ) {
			say STDERR "Option -D cannot be used with --show, -q or -u.";
			$params_ok = 0;
		}
		$quiet_mode = 1;
	}

	unless (defined $key) {
		say STDERR "What are you looking for?";
		$params_ok = 0;
		$key = "";
	}

	unless ( $querypkg->get_req_param('type') eq "use" ) {
		for (@unknown_with_hyphen) {
			say STDERR "- Tip: search term ", str_col("yellow",$_),
				" begins with a `-' character.\n  Maybe you gave an unknown ",
				"parameter and it was interpreted as search term?";
		}
	}

	set_fix( \$key );
	my $check = $querypkg->package_name_check( $key, undef );
	if ($check == App::Querypkg::PKG_NAME_TOO_SHORT
			or $check == App::Querypkg::PKG_NAME_TOO_LONG) {
		say STDERR "- Search term should contain no less than two ",
			"and no more than sixty four letters.";
		say STDERR "For a set, the minimum is one character."
			if $querypkg->get_req_param( 'type' ) eq "set";
		exit 1;
	}
	elsif ($check != App::Querypkg::PKG_NAME_OK) {
		say STDERR "Invalid package name: unknown ($check)";
		exit 1;
	}

	unless ($params_ok) {
		say STDERR "\nSpecify correct parameters. Try -h or --help or run this",
			" script without any\nparameters for interactive usage. Exiting!";
		exit 1;
	}

	$querypkg->make_URI( $key );
}

# this one used only with command line UI
sub display_help {
	# default/currently selected values
	my $s_arch  = $querypkg->get_req_param('arch');
	my $s_type  = $querypkg->get_req_param('type');
	my $s_order = $querypkg->get_req_param('order');
	my $s_repo  = $querypkg->get_req_param('repo');

	my %h_type  = $querypkg->get_API_array('type');
	my %h_order = $querypkg->get_API_array('order');
	my %h_repo  = $querypkg->get_API_array('repo');

	my @arch_opts  = $querypkg->get_API_array('arch', 1);
	my @type_opts  = $querypkg->get_API_array('type', 1);
	my @order_opts = $querypkg->get_API_array('order', 1);
	my @repo_opts  = $querypkg->get_API_array('repo', 1);

	my $arch_opts  = join "|",@arch_opts;
	my $type_opts  = join "|",@type_opts;
	my $order_opts = join "|",@order_opts;
	my $repo_opts  = join "|",@repo_opts;

	# For easy and readable string interpolation; $B{'-q'} looks quite like in POD!
	my %B = map { $_ => str_col("bold blue", $_) }
		qw(keyword -q --quiet -u -D --arch --order --type --repo --show
		--color --nocolor);
	my $helpstr =<<END;
	This is a Perl script to query packages using packages.sabayon.org.
	For interactive use run this script without any parameters.
	Usage:
	\t<$B{'keyword'}> [$B{'-q'}|$B{'--quiet'}] [$B{'-u'}]
	\t<$B{'keyword'}> [$B{'-D'}]
	\t[$B{'--arch'} $arch_opts] [$B{'--order'} $order_opts]
	\t[$B{'--type'} $type_opts] [$B{'--repo'} $repo_opts]
	Additional options: $B{'--color'} - enable colorized output (default),_no_nl_
	$B{'--nocolor'} - disable colorized output,_no_nl_
	$B{'--quiet'}/$B{'-q'} - produce less output,_no_nl_
	$B{'-u'} - print URL to get package details,_no_nl_
	$B{'--show'} <prop[,prop2 ...]> - specify properties to show,_no_nl_
	$B{'-D'} - only show digest and download location (usable for scripts).

	example usage: $0 $B{'--arch'} x86 $B{'--order'} size pidgin
	order does not matter: $0 pidgin $B{'--arch'} x86 $B{'--order'} size
	usage of $B{'--show'}: $0 pidgin $B{'--show'} desc,vo
	  (arguments to $B{'--show'} should match the whole property name or its
	  beginning, for example "vote" or "vo")
END
	$helpstr =~ s/^\t//gm;
	$helpstr =~ s/_no_nl_\n/ /g;
	say $helpstr;
	say "  default option is marked with an asterisk; default arch: $s_arch";
	say "$B{'--type'}:";
	for (@type_opts) {
		printf "%-14s%s %s\n", $_,
			($_ eq $s_type ? str_col("bold blue","*") : " "),
			$h_type{$_}->{desc};
	}
	say "\n$B{'--order'}:";
	for (@order_opts) {
		printf "%-14s%s %s\n", $_,
			($_ eq $s_order ? str_col("bold blue","*") : " "),
			$h_order{$_}->{desc};
	}
	say "\n$B{'--repo'}:";
	for (@repo_opts) {
		printf "%-14s%s %s\n", $_,
			($_ eq $s_repo ? str_col("bold blue","*") : " "),
			$h_repo{$_}->{desc};
	}
}

sub interactive_ui {
	say "Hello! This is a Perl script to query packages using packages.sabayon.org.\n",
		"Type a number or letter and enter to change any of these settings\n",
		"(for example, 1<enter> to change architecture type).\n",
		"Note: invoke this script with -h or --help for help on non-interactive usage.";

	my @arch_opts  = $querypkg->get_API_array('arch', 1);

	my ($s_arch, $s_type, $s_order);
	my ($type_desc, $order_desc, $repo_desc);

	my %h_arch  = $querypkg->get_API_array('arch');
	my $fmt = sub {
		my ($key, $name, $desc) = @_;
		if (defined $desc) {
			$key = "[$key]";
			$name = "$name:";
		}
		say
			str_col( "bold", "  " . $key ),
			str_col( "green", " " . $name ),
			defined $desc ? " " . str_col( "bold blue", $desc ) : ""
	};

	my $display_prop = "";
	my $key;
	while (1) {
		$s_arch  = $querypkg->get_req_param('arch');
		$s_type  = $querypkg->get_req_param('type');
		$s_order = $querypkg->get_req_param('order');

		$type_desc  = $querypkg->get_API_sel( 'type' )->{desc};
		$order_desc = $querypkg->get_API_sel( 'order' )->{desc};
		$repo_desc  = $querypkg->get_API_sel( 'repo' )->{desc};

		say "";
		$fmt->( '1', "arch",
			"$s_arch [" .
			join (", ", map { $h_arch{$_}->{desc} } @arch_opts) .
			"]" );
		$fmt->( '2', "search type", "$s_type ($type_desc)" );
		$fmt->( '3', "order", "$s_order ($order_desc)" );
		$fmt->( '4', "repository", $repo_desc );
		$fmt->( 'c', "color", $use_colour ? "enabled" : "disabled" );
		$fmt->( 't', "quiet", $quiet_mode ? "enabled" : "disabled" );
		$fmt->( 'u', "print URL to get package details",
			$print_details_url ? "enabled" : "disabled" );
		$fmt->( 'D', "print digest and dowload location",
			$print_download_location ? "enabled" : "disabled");
		$fmt->( 'p', "properties to print", $display_prop || "all" );
		$fmt->( '[q]', "quit" );
		$fmt->( '(any other)', "continue" );

		$key = <STDIN> || "";
		chomp $key;
		say "";

		if ($key eq "1") {
			say "select architecture:";
			pnt_set_opt('arch', 0);
		}
		elsif ($key eq "2") {
			say "select search type:";
			pnt_set_opt('type', 0);
		}
		elsif ($key eq "3") {
			say "select sort order:";
			pnt_set_opt('order', 1);
		}
		elsif ($key eq "4") {
			say "select repository:";
			pnt_set_opt('repo', 0);
		}
		elsif ($key eq "c") {
			$use_colour = !$use_colour;
		}
		elsif ($key eq "t") {
			$quiet_mode = !$quiet_mode;
		}
		elsif ($key eq "u") {
			$print_details_url = !$print_details_url;
		}
		elsif ($key eq "D") {
			$print_download_location = !$print_download_location;
		}
		elsif ($key eq "p") {
			say "type what properties you want to print";
			say "arguments should match the whole property name or its ",
				"beginning; for example \"vote\" or \"vo\"";
			say "arguments are comma separated, example: vote,desc";
			print "> ";
			$display_prop = <STDIN> || "";
			chomp ($display_prop);
			# "properties to print: all" means "all", so let it be the other
			# way round too
			$display_prop = "" if $display_prop eq "all";
			$display_prop =~ s/, /,/g;
			@display_prop = ();
			for (split ',', $display_prop) {
				push @display_prop, lc($_) if length $_;
			}
			$display_prop = join ", ", @display_prop;
		}
		elsif ($key eq "q") {
			say "Bye!";
			exit 0;
		}
		else {
			last;
		}
	}

	say "What are you looking for? Type your search term.";
	if (length $key) {
		say "(If it is $key, just press Enter.)";
	}

	while (1) {
		my $new_key = <STDIN> || ""; # C-d handled
		chomp $new_key;
		# for "If it is $key, just press Enter." - pressed Enter without typing anything:
		if (length $new_key == 0) {
			$new_key = $key;
			$key = "";
		}

		set_fix( \$new_key );
		my $check = $querypkg->package_name_check( $new_key, undef );
		if( $check != App::Querypkg::PKG_NAME_OK ) {
			if( $check == App::Querypkg::PKG_NAME_TOO_SHORT ) {
				say "Too short! Try again or type Ctrl+C to abort.";
			}
			elsif( $check == App::Querypkg::PKG_NAME_TOO_LONG ) {
				say "Too long! Try again or type Ctrl+C to abort.";
			}
			else {
				say "Invalid package name (unknown reason; code = $check). ",
					"Try again or type Ctrl+C to abort."
			}
		}
		else {
			$key = $new_key;
			last;
		}
	}

	$querypkg->make_URI( $key );
}

# for interactive UI
sub pnt_set_opt {
	my $param = shift or die "no arg!"; # 'arch' etc.
	my $print_opt = shift; # print option name, too?
	my $s_tmp = $querypkg->get_req_param( $param );
	my %h_tmp = $querypkg->get_API_array( $param );

	if ($print_opt) {
		say "currently selected: ",
			str_col( "bold green", "$s_tmp (" . $h_tmp{$s_tmp}->{desc} . ")" );
	}
	else {
		say "currently selected: ",
			str_col( "bold green", $h_tmp{$s_tmp}->{desc} );
	}

	# populate keys, in order
	my @keys = $querypkg->get_API_array( $param, 1 );

	my $l = 'a';
	for my $opt (@keys) {
		my $l_col = str_col( "bold", "[$l]" );
		if ($print_opt) {
			say "  $l_col $opt (", $h_tmp{$opt}->{desc}, ")";
		}
		else {
			say "  $l_col ", $h_tmp{$opt}->{desc};
		}
		$l++;
	}

	my $resp = <STDIN> || "";
	chomp $resp;
	if ($resp lt 'a' or $resp ge $l) {
		# do nothing if no argument/out of range
	}
	else {
		$s_tmp = $keys[ord ($resp) - ord ('a')];
		$querypkg->set_req_params( $param, $s_tmp );
	}

	if ($print_opt) {
		say "selected: $s_tmp (", $h_tmp{$s_tmp}->{desc}, ")";
	}
	else {
		say "selected: ", $h_tmp{$s_tmp}->{desc};
	}
	$s_tmp;
}

sub set_fix {
	my $key_ref = shift;
	die "not a ref" unless ref $key_ref;
	if ($$key_ref =~ /^@/) {
		if (not $querypkg->get_req_param('type') eq "set") {
			say STDERR str_col("red","Info: "),
				qq{package name starts with @ - assuming search type "set".\n};
			$querypkg->set_req_params( type => 'set' );
		}
		$$key_ref = substr $$key_ref, 1;
	}
}

sub str_col {
	my $col = shift or return "";
	if ($use_colour) {
		return color($col) . (join "",@_) . color("reset");
	}
	else {
		return join "",@_;
	}
}

sub want_this_prop {
	if (@display_prop) {
		my $prop = shift;
		$prop = lc $prop;
		for (@display_prop) {
			return 1 if index ($prop, $_) == 0;
		}
		return 0;
	}
	return 1;
}

### subs for printing package data ###

sub pnt_atom_name {
	my $atom = shift;
	my %opts = @_; # booleans: quiet
	if ($opts{quiet}) {
		print $atom->{atom};
	}
	else {
		print str_col("green",">>      "), str_col("bold red","@@ Package: "),
			str_col("bold",$atom->{atom});
	}

	# Print without trailing newlines to support printing many properties
	# in one line in "quiet" mode.
	print "\n" unless $opts{quiet};
}

sub pnt_prop {
	my ($label, $color, $value, %opts) = @_; # %opts: quiet, want_this

	return unless $opts{want_this} || want_this_prop ($label);

	if( $opts{quiet} ) {
		return unless @display_prop;
		print str_col("cyan", " {"), $label, str_col($color, $value),
			str_col("cyan", "}");
	}
	else {
		my $len = length $label;
		my $pad = $len > 15 ? 15 : 15 - $len;
		say str_col("green",">>")," "x9, str_col("green",$label),
			" "x$pad, str_col($color,$value);
	}
}

sub pnt_prop_wrap {
	my $label = shift;
	return unless want_this_prop ($label);
	my ($color, $text, %opts) = @_; # %opts: quiet

	if ($opts{quiet}) {
		return unless @display_prop;
		print str_col("cyan", " {"), $label, str_col($color, $text),
			str_col("cyan", "}");
		return;
	}

	my $len = length $label;
	my $WIDTH = 80;
	my $pad = $len > 15 ? 15 : 15 - $len;

	my $textlen = length $text;
	# $indent = space on the beginning of a line
	my $indent = 2 + $len + 9 + $pad;
	#my $indenttext =  " " x $indent;
	my $indenttext = str_col("green", ">>") . " " x ($indent - 2);
	my $widthavail = $WIDTH - $indent;
	my $outtext;
	if ($textlen <= $widthavail) {
		$outtext = str_col($color,$text);
	}
	else {
		my $line = "";
		my @lines = ();
		my $cur_widthavail = $widthavail;
		for my $word (split /\s/, $text) {
			A_LABEL:
			if (length $word < $cur_widthavail) {
				$line .= $word . " ";
				$cur_widthavail -= (length($word) + 1);
			}
			elsif (length $word == $cur_widthavail) {
				$line .= $word . "\n";
				push @lines, $line;
				$line = "";
				$cur_widthavail = $widthavail;
			}
			# the word length exceeds space that left
			else {
				# maybe it's longer than available width?
				if (length $word > $widthavail) {
					$line .= (substr $word, 0, $cur_widthavail) . "\n";
					push @lines, $line;
					$line = "";
					$word = substr $word, $cur_widthavail;
					$cur_widthavail = $widthavail;
					goto A_LABEL;
				}
				# otherwise let's put in on a new line
				else {
					push @lines, ($line . "\n");
					$line = $word . " ";
					$cur_widthavail = $widthavail - (length ($word) + 1);
				}
			}
		}
		push @lines, $line if $line;
		# for (@lines) { print "[$_]" };
		# $outtext = join $indenttext,@lines;
		$outtext = join $indenttext,(map { str_col($color,$_) } @lines);
	}

	say str_col("green",">>")," "x9, str_col("green",$label),
			" "x$pad, $outtext; #str_col($color,$outtext);
}

sub pnt_properties {
	my $atom = shift;
	my $quiet = shift;

	# a helper to call the right sub
	my $pnt = sub {
		my ($label, $col, $value, %opts) = @_;
		if( $opts{wrap} ) {
			pnt_prop_wrap( $label, $col, $value, quiet => $quiet_mode );
		}
		else {
			pnt_prop( $label, $col, $value, quiet => $quiet_mode );
		}
	};

	$pnt->( "Arch:", "bold blue", $atom->{arch} );
	$pnt->( "Revision:", "bold blue", $atom->{revision} );
	$pnt->( "Slot:", "bold blue", $atom->{slot} );
	$pnt->( "Size:", "bold blue", $atom->{size} );
	$pnt->( "Downloads:", "bold blue", $atom->{downloads} );
	$pnt->( "Vote:", "bold blue", $atom->{vote} );
	$pnt->( "spm_repo:", "bold blue", $atom->{spm_repo} // "(null)" );
	$pnt->( "Homepage:", "yellow", $atom->{homepage} // "(null)" );
	$pnt->( "Description:", "magenta", $atom->{description}, wrap => 1 );
	$pnt->( "Date:", "bold blue", $atom->{date} );
	$pnt->( "License:", "cyan", $atom->{license} );
	$pnt->( "Last change:", "bold blue", $atom->{change} // "N/A", wrap => 1 );

	$pnt->( "Repository:", "bold blue", $atom->{repository} );

	if ($print_details_url) {
		my $url = $atom->{url_details} // "(URL unknown)";
		if ($quiet_mode) {
			say " :: ", str_col( "yellow", $url );
		}
		else {
			pnt_prop ( "Details page:", "underline", $url,
				want_this => 1, quiet => 0 );
		}
	}
}

sub pnt_download_location {
	my $atom = shift;
	say join(" ", $atom->{key}, $atom->{digest}, $atom->{download_path});
}

sub print_package_details {
	my $atom = shift;
	if ($print_download_location) {
		pnt_download_location( $atom );
	}
	else {
		pnt_atom_name( $atom, quiet => $quiet_mode );
		pnt_properties( $atom, quiet => $quiet_mode );
		print "\n" if $quiet_mode;
	}
}

run();
