cmdline.pm

# Commandline user interface
# Copyright (C) 2009-2014, AllWorldIT
# Copyright (C) 2008, LinuxRulz
# Copyright (C) 2005-2007 Nigel Kukard  <nkukard@lbsd.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.




package wiaflos::client::cmdline;

use strict;

# Exporter stuff
require Exporter;
our (@ISA,@EXPORT);
@ISA = qw(Exporter);
@EXPORT = qw(
	execute
);

use POSIX qw( floor );
use Text::ParseWords;

use wiaflos::constants;
use wiaflos::client::config;
use wiaflos::client::soap;
use wiaflos::client::misc;



# Modules to load
my @modules = qw(
	Engine
	GL
	Tax
	Inventory
	Clients
	Invoicing
	Suppliers
	Purchasing
	Payments
	Receipting
	Statements
	SupplierCreditNotes
	SupplierReceipting
	Reporting
	YearEnd
);
my @plugins;
my $cmdline;

# Merge menu items
sub mergeMenu
{
	my ($menuA,$menuB) = @_;


	# Loop with menu B
	foreach my $itemB (@{$menuB}) {
		my $node;

#		print(STDERR "ItemB: ".$itemB->{'MenuItem'}."\n");

		# Loop with main menu we merging into to find the sub item
		foreach my $itemA (@{$menuA->{'Children'}}) {
#			print(STDERR "ItemA: ".$itemA->{'MenuItem'}.", ItemB: ".$itemB->{'MenuItem'}."\n");

			# Check for match
			if ($itemB->{'MenuItem'} eq $itemA->{'MenuItem'}) {
#				print(STDERR "Match\n");
				$node = $itemA;
			}
		}

		# Check for match
		if (!defined($node)) {
#			print(STDERR "No match, adding\n");
			push(@{$menuA->{'Children'}},$itemB);
		} else {
			# Merge children
			mergeMenu($node,$itemB->{'Children'});
		}
	}
}


# Start our interface
my $cmdMap;
my @cmdHistory = ();
my @cmdPos = ();
sub ui_start
{
	# Load modules
	foreach my $module (@modules) {
		loadPlugin($module);
	}

	# Build command map
	$cmdMap->{'Children'} = [
		# Core
		{
			'MenuItem'	=> 'Quit',
			'Regex'		=> 'quit$',
			'Desc'		=> 'Exit',
			'Help'		=> 'quit',
			'Function'	=> \&cmd_quit,
		},
		{
			'MenuItem'	=> 'Connect',
			'Regex'		=> 'connect',
			'Desc'		=> 'Connect to an accounting server',
			'Help'		=> 'connect <username> <password> [uri]',
			'Function'	=> \&cmd_connect,
		},
		{
			'MenuItem'	=> 'Load',
			'Regex'		=> 'load',
			'Desc'		=> 'Load a wiaflos file',
			'Help'		=> 'load file="<filename>"',
			'Function'	=> \&loadFile,
		},
	];

	# Merge menu's
	foreach my $plugin (@plugins) {
		mergeMenu($cmdMap,$plugin->{'Menu'});
	}

	# Setup term
	my $OUT = \*STDOUT;

	# Check for command-line stuff
	if ($cmdline->{'connect'}) {
		if (processCommand($OUT,"connect $cmdline->{'connect'}")) {
			exit 1;
		}
	}

	# Check if we using raw stdin
	if (defined(my $file = $cmdline->{'load-file'})) {
		# - is a special filename used for STDIN
		if ($file eq "-") {
			# Read from stdin - hack as we don't have a function
			while (my $line = <STDIN>) {
				# Chomp off newline
				chomp($line);
				# Process command
				if (my $res = processCommand($OUT,$line) < 0) {
					exit 1;
				}
			}
		# For everything else try open the file
		} else {
			# We don't need line buffering when processing files...
			$OUT->autoflush();
			# Exit with code given by the loadFile function
			if (loadFile($OUT,"file='$file'") < 0) {
				exit 1;
			}
		}
		# Exit normally
		exit 0;
	}

	# Start interactive interface
	use Term::ReadLine;
	my $term = new Term::ReadLine 'Wiaflos Accounting';

	$OUT = $term->OUT;

	# While input process, else its ctrl-D
	while (defined(my $cmdline = $term->readline(join('/',@cmdPos)."> "))) {
		processCommand($OUT,$cmdline);
		$term->addhistory($cmdline);
	}

	print($OUT "\n");
	cmd_quit($OUT);
}


# Load an wiaflos file
sub loadFile
{
	my ($OUT,@args) = @_;

	my $parms = parseArgs(@args);


	if (!defined($parms->{'file'})) {
		return -202;
	}

	# Open file
	my $FH;
	if (!open($FH,"<",$parms->{'file'})) {
		print($OUT " => Failed to open '".$parms->{'file'}."': $!\n");
		return -1;
	}

	# Process lines
	printf($OUT " => Loading file '%s'\n",$parms->{'file'});

	# Grab number of lines to process
	my $line_total = 0;
	while (<$FH>) { $line_total++ }

	# Reset back to beginning of file and re-read
	seek($FH,0,0);
	# Reset line counter (NK: UNDOCUMENTED)
	$FH->input_line_number(0);

	# Loop again with each line number
	my $line_current = 0;
	my $percent_last = "";
	my @history = ();
	while (my $cmdline = <$FH>) {
		# Bump line number
		$line_current++;

		# Grab percent done
		my $percent_done = sprintf('%5.1f',floor(($line_current / $line_total) * 1000) / 10);
		# If its changed, output and save
		if ($percent_done ne $percent_last) {
				print($OUT "    Progress: $percent_done\n");
				$percent_last = $percent_done;
		}

		# Nuke whitespaces at end
		chomp($cmdline);

		# Short circuit blank lines
		next if ($cmdline eq "");

		# Process
		if ((my $res = processCommand($OUT,$cmdline)) < 0) {
			# List last 5 success lines
			foreach my $line (@history) {
				print($OUT " => SUCCESS: $line\n");
			}
			# Lastly list the failure
			print($OUT " => FAILURE: $cmdline\n");
			return $res;
		}

		# Store history so we can give better errors
		push(@history,$cmdline);
		# Store only 5 lines of history
		if (@history > 5) {
			shift(@history);
		}
	}

	# Close
	close($FH);


	return 0;
}


# Command: connect
sub cmd_connect
{
	my ($OUT,@args) = @_;


	# Special case for local
	if (@args > 0 && $args[0] eq "local") {
		my $cfg;

		# Set defaults
		$cfg->{'config_file'} = CONFIG_FILE;

		# Parse commandline arguments
		if (defined($cmdline->{'config'}) && $cmdline->{'config'} ne "") {
			$cfg->{'config_file'} = $cmdline->{'config'};
		}

		# Check config file exists
		if (! -f $cfg->{'config_file'}) {
			print(STDERR "ERROR: No configuration file '".$cfg->{'config_file'}."' found!\n");
			exit 1;
		}

		# Load server modules
		eval(qq(
			use Config::IniFiles;
			use awitpt::cache;
			use wiaflos::server::api::auth;
			use wiaflos::server::core::config;
			use wiaflos::server::core::jobs;
			use wiaflos::server::core::templating;
		));
		if ($@) {
			print(STDERR "Error loading server core ($@)\n");
			exit 1;
		}

		# Use config file, ignore case
		tie my %inifile, 'Config::IniFiles', (
				-file => $cfg->{'config_file'},
				-nocase => 1
		) or die "Failed to open config file '".$cfg->{'config_file'}."': $!";
		# Copy config
		my %config = %inifile;

		my $server = wiaflos::client::fakeserver->new();
		$server->{'inifile'} = \%config;

		# Init authentication
		wiaflos::server::api::auth::init($server);
		# Init config
		wiaflos::server::core::config::Init($server);
		# Init templating engine
		wiaflos::server::core::templating::Init($server);
		# Init caching engine
		# NK: As we're local disable caching
		$awitpt::cache::cache_type = "none";
		awitpt::cache::Init($server);
		# Init jobs
		wiaflos::server::core::jobs::Init($server);

		# Setup database handle
		awitpt::db::dblayer::setHandle($server->{'client'}->{'dbh'});

		eval(qq(
			use wiaflos::server::api::SOAPTest;
			use wiaflos::server::api::Engine;
			use wiaflos::server::api::GL;
			use wiaflos::server::api::Clients;
			use wiaflos::server::api::Inventory;
			use wiaflos::server::api::Invoicing;
			use wiaflos::server::api::Payments;
			use wiaflos::server::api::Purchasing;
			use wiaflos::server::api::Receipting;
			use wiaflos::server::api::Reporting;
			use wiaflos::server::api::Statements;
			use wiaflos::server::api::SupplierCreditNotes;
			use wiaflos::server::api::SupplierReceipting;
			use wiaflos::server::api::Suppliers;
			use wiaflos::server::api::Tax;
			use wiaflos::server::api::YearEnd;
		));
		if ($@) {
			print(STDERR "Error loading API ($@)\n");
			exit 1;
		}
	}

	return soapConnect($OUT,@args);
}


# Command: quit
sub cmd_quit
{
	my ($OUT,@args) = @_;

	print($OUT "Exiting...\n");

	exit 0;
}


# Process command
sub processCommand
{
	my ($OUT,$cmdline) = @_;


	# If whitespace only or comment
	return 0 if ($cmdline =~ /^\s*$/ || $cmdline =~ /^\s*#/);

	# Optimize by removing spaces from beginning and end of line
	$cmdline =~ s/^\s+//;
	chomp($cmdline);


	# Check for special: ..
	if ($cmdline eq "..") {
		# If we have history, shift it in
		if (@cmdHistory > 0) {
			$cmdMap = pop(@cmdHistory);
			pop(@cmdPos);
		} else { # Else error to client
			print($OUT " => You are already on the top level.\n");
		}

		return 0;


	# Check for special: help
	} elsif ($cmdline eq "help") {
		print($OUT "Valid commands...\n");

		# Loop commands
		foreach my $i (@{$cmdMap->{'Children'}}) {
			# Check if valid in this state
#			if (!defined($i->{'type'})
#					|| (
#						defined($i->{'type'}) && ($i->{'type'} == 0
#						|| (!soapConnected() && $i->{'type'} == 1)
#						|| (soapConnected() && $i->{'type'} == 2)))
#					) {
#				print($OUT $i->{'MenuItem'}."\t- ".$i->{'Desc'}."\n");
#			}
			# Check type of menu item
			if (defined($i->{'Children'})) {
				print($OUT $i->{'MenuItem'}."/\n");
			} else {
				print($OUT $i->{'MenuItem'}."\n");
			}
		}

		return 0;

	# Check for special: help <command>
	} elsif (my ($cmd) = ($cmdline =~ /^help\s*(\S+)$/i)) {
		my $res = 0;
		# Loop with commands
		foreach my $i (@{$cmdMap->{'Children'}}) {
			# Hop over children menu items
			next if (defined($i->{'Children'}));
#		print(STDERR "DEBUG: cmdline = '$cmd' vs. '$i->{'Regex'}'\n");

			if ($cmd =~ /^\s*$i->{'Regex'}\s*$/i) {
				print($OUT "Usage...\n");
				print($OUT "  ".$i->{'Help'}."\n");
				$res = 1;
				last;
			}
		}

		print($OUT " => ERROR - Command not found\n") if (!$res);

		return 0;
	}



	my $res = -200;
	my $matchedCmd;

	# Loop with commands & test
	foreach my $i (@{$cmdMap->{'Children'}}) {

		# Test command for match
		if ((defined($i->{'Children'}) && $cmdline =~ /^\s*$i->{'MenuItem'}\s*$/i)
				|| (defined($i->{'Regex'}) && $cmdline =~ /^\s*$i->{'Regex'}(?:\s+|$)/i) ) {

			# Check state definition
#			if (!defined($i->{'type'})
#					|| (
#						defined($i->{'type'}) && ($i->{'type'} == 0
#						|| (!soapConnected() && $i->{'type'} == 1)
#						|| (soapConnected() && $i->{'type'} == 2)))
#					) {

				# Check if we have children commands
				if (defined($i->{'Children'})) {
					# Save history
					push(@cmdHistory,$cmdMap);
					push(@cmdPos,$i->{'MenuItem'});
					# Change map
					$cmdMap = $i;
					# Success
					$res = undef;
				} else {
					# Substitute
					my $substitution = $i->{'Substitute'} ? defined($i->{'Substitute'}) : "";
					(my $fcmd = $cmdline) =~ s/^\s*$i->{'Regex'}\s*/$substitution/i;

#					print($OUT "Found '".$i->{'Regex'}."', dest '".$fcmd."'\n");

					# Pull args
					my @args = shellwords($fcmd);

					# If defined, call ... else exit
					$res = $i->{'Function'}($OUT,@args);

					$matchedCmd = $i;
				}
#			} else {
#				$res = -201;
#			}

			last;
		}
	}


	# If no command, give error
	if (!defined($res)) {
		return 0;
	} elsif ($res == 0) {
#		print($OUT " => Ok!\n");
	} elsif	($res > 0) {
#		print($OUT " => Ok! (res: $res)\n");
	} elsif ($res == -103) {
		print($OUT " => ERROR - Not authorized to access this function: $cmdline\n");
	} elsif ($res == -200) {
		print($OUT " => ERROR - Invalid command: $cmdline\n");
	} elsif ($res == -201) {
		print($OUT " => ERROR - Command not valid in this state: $cmdline\n");
	} elsif ($res == -202) {
		print($OUT " => ERROR - Usage error: $cmdline\n");
		print($OUT "  ".$matchedCmd->{'Help'}."\n");
	} else {
		print($OUT " => ERROR - Processing line: $cmdline\n");
		print($OUT " => ERROR - Unknown result: $res\n");
	}

	return $res;
}



sub execute
{
	$cmdline = shift;

	ui_start;
}









# Load a plugin
sub loadPlugin
{
	my $plugin = shift;


	# Load module
	my $res = eval(qq(
		use wiaflos::client::cmdline::$plugin;
		registerPlugin(\"$plugin\",\$wiaflos::client::cmdline::${plugin}::pluginInfo);
	));
	if ($@ || (defined($res) && $res != 0)) {
		print(STDERR "Error loading plugin $plugin ($res:$@)\n");
	}
}

# Register plugin info
sub registerPlugin {
	my ($plugin,$info) = @_;


	# If no info, return
	if (!defined($info)) {
		print(STDERR "Plugin info not found for plugin => $plugin\n");
		return -1;
	}

	# Set real module name & save
	$info->{'Module'} = $plugin;
	push(@plugins,$info);

	# Just a bit of debug
	print(STDERR "Info: Loaded plugin => $plugin\n");

	return 0;
}



# Fake server used when calling the API directly
package wiaflos::client::fakeserver;

use DateTime;
use wiaflos::server::core::logging;

sub new {
	my $class = shift;
	return bless {}, $class;
}

sub map_dispatch
{
	my ($self) = @_;
}


# Slightly better logging
sub log
{
	my ($self,$level,$msg,@args) = @_;

	# Check log level and set text
	my $logtxt = "UNKNOWN";
	if ($level == LOG_DEBUG) {
		$logtxt = "DEBUG";
	} elsif ($level == LOG_INFO) {
		$logtxt = "INFO";
	} elsif ($level == LOG_NOTICE) {
		$logtxt = "NOTICE";
	} elsif ($level == LOG_WARN) {
		$logtxt = "WARNING";
	} elsif ($level == LOG_ERR) {
		$logtxt = "ERROR";
	}

	# Parse message nicely
	if ($msg =~ /^(\[[^\]]+\]) (.*)/s) {
		$msg = "$1 $logtxt: $2";
	} else {
		$msg = "[CORE] $logtxt: $msg";
	}

	# If we have args, this is more than likely a format string & args
	if (@args > 0) {
		$msg = sprintf($msg,@args);
	}

	my $timestamp = DateTime->now();

	printf(STDERR "[".$timestamp->strftime("%F %T")." - $$] $msg\n",@args);
}



1;
# vim: ts=4