#!/usr/bin/perl

=head1 NAME

gdc - Client utility for GoodData on-demand Business Intelligence platform

=head1 SYNOPSIS

gdc [global options] <command> [command options]

=head1 DESCRIPTION

B<gdc> is the command-line and interactive client for GoodData REST-ful
service API built on top of L<WWW::GoodData> client library.

=cut

use WWW::GoodData;
use Getopt::Long qw/GetOptionsFromArray/;
use Pod::Usage;
use Text::ParseWords;
use Term::ReadLine;

use strict;
use warnings;

# Global context
my $gdc = new WWW::GoodData;
my $command = 'shell';
my $user;
my $password;
my $project;

=head1 OPTIONS

=over 4

=item B<-h>, B<--help>

Print a brief help message and exits.

=item B<-H>, B<--man>

Prints the manual page and exits.

=item B<-u>, B<--user> B<< <email> >>

Use the identity of specified user.
See also the B<login> command.

=item B<-p>, B<--password>

Log in on start, provided B<--user> option was set as well.

=item B<-P>, B<--project>

Project URI. It is used as a default value for commands that
accept project URI option (such as B<rmproject> and B<lsreports>)
and can be changed from within the shell (see B<project>
and B<mkproject> commands).

No checking is done with the project URI util a command that
acts upon the project is issued.

=back

=cut

new Getopt::Long::Parser (
	config => [qw/require_order/]
)->getoptions (
	'u|user=s' => \$user,
	'p|password=s' => \$password,
	'P|project=s' => \$project,
) or pod2usage (2);
$command = shift if @ARGV;

=head1 COMMANDS

=cut 

my %actions = (
	login => \&login,
	lsprojects => \&lsprojects,
	rmproject => \&rmproject,
	mkproject => \&mkproject,
	project => \&project,
	lsreports => \&lsreports,
	help => \&help,
	shell => \&shell,
);

=head2 shell

Launch an interactive client session.

This is the default action that is taken unless another
command is specified.

=cut

sub shell
{
	my $readline = new Term::ReadLine ('WWW::GoodData shell');
	while (1) {
		my $line = $readline->readline ("> ");
		return unless defined $line;
		$readline->addhistory ($line) if $line;
		my ($command, @args) = shellwords ($line);
		if (exists $actions{$command}) {
			eval { $actions{$command}->(@args) };
			warn $@ if $@;
		} else {
			warn 'No such command';
		}
	}
}

=head2 login [user] [password]

Verify user identity and obtain an authorization token.
If no credentials are supplied, global ones are used.

If the password is not specified, it is requested
from terminal provided terminal echo can be turned off.

This action is taken implicitly if user name has been specified.

=over 4

=item B<-u>, B<--user> B<< <email> >>

Alternative way to specifiy user login.

=item B<-p>, B<--password>

Alternative way to specifiy user password.

=back

=cut

sub login
{
	undef $password;
	GetOptionsFromArray (\@_,
		'u|user=s' => \$user,
		'p|password=s' => \$password,
	) or die 'Bad arguments to login';
	$user = shift if @_;
	$password = shift if @_;
	die 'Extra arguments' if @_;
	die 'No user name given' unless $user;

	# stty might not be portable to NT and such
	if (not defined $password and -t STDIN) {
		system 'stty -echo'
			and die 'Can not ask for password securely';
		print 'Password: ';
		chomp ($password = <>);
		print "\n";
		system 'stty echo';
	}

	$gdc->login ($user, $password);
}

=head2 project [uri]

Change or print the default project URI. Default project is used
by various commands involving projects, including B<mkproject> and
B<rmproject>.

=over 4

=item B<-p>, B<--project>

Project URI.
No checking is done with the project URI.

=back

=cut

sub project
{
	my $this_project;
	GetOptionsFromArray (\@_,
		'p|project' => \$this_project,
	) or die 'Bad arguments to lsprojects';
	$this_project = shift if @_;
	die 'Extra arguments' if @_;

	if ($this_project) {
		$project = $this_project;
	} else {
		print "$project\n";
	}
}

=head2 lsprojects

Print a list of available projects.

=over 4

=item B<-v>, B<--long>

Add unnecessary details.

=back

=cut

sub lsprojects
{
	my $long;

	GetOptionsFromArray (\@_,
		'v|long' => \$long,
	) or die 'Bad arguments to lsprojects';
	die 'Extra arguments' if @_;

	foreach my $project ($gdc->projects) {
		if ($long) {
			print "Link: ".$project->{link}."\n";
			print "\tTitle: ".$project->{title}."\n";
			print "\tSummary: ".$project->{summary}."\n";
			print "\tCreated: ".$project->{created}."\n";
			print "\tUpdated: ".$project->{updated}."\n";
		} else {
			print $project->{link}.' ';
			print $project->{title}."\n";
		}
	}
}

=head2 rmproject [uri]

Delete a project.

=over 4

=item B<-P>, B<--project>

Set or override the project to act on.
See global B<--project> option for the detailed description.

=back

=cut

sub rmproject
{
	my $project = $project;
	GetOptionsFromArray (\@_,
		'P|project=s' => \$project,
	) or die 'Bad arguments to rmproject';
	$project = shift if @_;
	die 'Extra arguments' if @_;
	die 'No project name given' unless $project;

	$gdc->delete_project ($project);
}

=head2 mkproject <title> [summary]

Create a project.

=over 4

=item B<-t>, B<--title>

Title of the project.

=item B<-s>, B<--summary>

Descriptive summary of the project.

=back

=cut

sub mkproject
{
	my $title;
	my $summary = '';

	GetOptionsFromArray (\@_,
		't|title=s' => \$title,
		's|summary=s' => \$summary,
	) or die 'Bad arguments to mkproject';
	$title = shift if @_;
	$summary = shift if @_;
	die 'Extra arguments' if @_;
	die 'No project title given' unless $title;

	$project = $gdc->create_project ($title, $summary);
}

=head2 lsreports [project]

Print a list of reports in a project.

=over 4

=item B<-P>, B<--project>

Set or override the project to act on.
See global B<--project> option for the detailed description.

=item B<-v>, B<--long>

Add unnecessary details.

=back

=cut

sub lsreports
{
	my $long;
	my $project = $project;

	GetOptionsFromArray (\@_,
		'v|long' => \$long,
		'P|project' => \$project,
	) or die 'Bad arguments to lsprojects';
	$project = shift if @_;
	die 'Extra arguments' if @_;
	die 'No project URI given' unless $project;

	foreach my $report ($gdc->reports ($project)) {
		if ($long) {
			print "Link: ".$report->{link}."\n";
			print "\tTitle: ".$report->{title}."\n";
			print "\tSummary: ".$report->{summary}."\n";
			print "\tCreated: ".$report->{created}."\n";
			print "\tUpdated: ".$report->{updated}."\n";
		} else {
			print $report->{link}.' ';
			print $report->{title}."\n";
		}
	}
}

=head2 help

Print list of available commands.

=cut

sub help
{
	GetOptionsFromArray (\@_)
		or die 'Bad arguments to help';
	die 'Extra arguments' if @_;

	print map { "$_\n" } 'Valid commands: ',
		map { "\t$_" } keys %actions ;
}

$gdc->login ($user, $password) if defined $user;
pod2usage ("No such command exists: '$command'")
	unless exists $actions{$command};
$actions{$command}->(@ARGV);

=head1 SEE ALSO

=over

=item *

L<https://secure.gooddata.com/gdc/> -- Browsable GoodData API

=item *

L<WWW::GoodData> -- Client library for GoodData

=item *

L<LWP::UserAgent> -- Perl HTTP client

=back

=head1 COPYRIGHT

Copyright 2011, Lubomir Rintel

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

=head1 AUTHOR

Lubomir Rintel C<lkundrak@v3.sk>

=cut
