Inserting broken cli script host

git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@459 4979c152-3d1c-0410-bac9-87ea11338e46

1 files changed, 107 insertions, 23 deletions

diff --git a/utils/cli/ledgersmb_cli.pl b/utils/cli/ledgersmb_cli.pl
index 82a9785b..4652c2d5 100644
--- a/utils/cli/ledgersmb_cli.pl
+++ b/utils/cli/ledgersmb_cli.pl
@@ -20,38 +20,122 @@
 #
 # THIS IS EXPERIMENTAL AND THE INTERFACE IS SUBJECT TO CHANGE
 
-
+use Parse::RecDescent;
 use LedgerSMB::User;
 use LedgerSMB::Form;
 use LedgerSMB::Sysconfig;
 
 $form = new Form;
 
-while ($line = <>){
-	$line =~ s/#.*//; # strip out comments
-	if ($line =~ /^\s*CALL\s+(.+)\s+INTO\s+(.+)/i){
-		$form->{$2} = &{$1}(\%$form);
-	} elsif ($line =~ /^\s*MODULE (.+)/i){
-		$module = $1;
-		$module =~ s/::/\//;
-		eval { require $module; };
-	} elsif ($line =~ /^\s*ENV:(.+)\s*=\s*(.*)/i){
-		my ($key, $value) = ($1, $2);
-		$key =~ s/\s?(.*)\s?/$1/;
-		$value =~ s/\s?(.*)\s?/$1/;
-		$ENV{$1} = $2;
-	} elsif ($line =~ /^\s*(.+)\s*=\s*(.+)/){
-		$form->{$1} = $2;
-	} elsif ($line =~ /^\s*CALL\s+(.+)/i){
-		{$1};
-	} elsif ($line =~ /^\s*LOGIN\s*/i){
-		$myconfig = new LedgerSMB::User 
-			"${LedgerSMB::Sysconfig::memberfile}", "$form->{login}";
-	} elsif ($line !~ /^\s*$/) {
-		die "Parse error in script file: $line";
+$syntax = << '_END_SYNTAX_';
+
+	KEY : /\w[a-z0-9_]*/i
+	FNKEY : /\w[a-z0-9_]*/i
+	MODSTR: /\w[a-z0-9_:]*/i
+	OP       : m([-+*/%])
+	NUMBER : /[+-]?\d*\.?\d+/
+
+	ARGSTR : /\w[a-z0-9_,\s]*/i 
+
+	expression : NUMBER OP expression
+              { return main::expression(@item) }
+              | key OP expression
+              { return main::expression(@item) }
+              | INTEGER
+              | VARIABLE
+
+	assign_instruction : KEY "=" expression
+		{ ${main::stackref}->{$item{key}} = $item{expression} }
+
+	call_and_assign : /call/i FNKEY(ARGSTR) /into/i KEY
+		{ main::call_and_assign($item{FNKEY}, $item{ARGSTR}, $item{KEY}) }	
+
+	call : /call/i FNKEY(ARGSTR)
+		{ main::call($item{FNKEY}, $item{ARGSTR}) }
+
+	for : /for/i KEY
+		{ main::push_loop($item{KEY}) }
+
+	done : /^\s*done\s*$/
+		{ main::pop_loop() }
+
+	if : /^\s*if/i KEY
+		{ main::if_handler($item{KEY} }
+
+	# IF is terminated by END IF or FI on its own line
+
+	login : /login/i
+		{ main::login() }
+
+	module : /module/i MODSTR
+		{ main::load_mod($item{MODSTR} }
+
+	instruction : assign_instruction
+		| call_and_assign
+		| call
+		| for
+		| done
+		| if
+		| login
+		| module
+
+	startrule : instruction
+
+_END_SYNTAX_
+
+my $stackref;
+my @loopstack;
+
+sub call {
+	my ($call, $argstr) = @_;
+	$argstr =~ s/form/\\\%\$form/;
+	$argstr =~ s/user/\\\%myconfig/;
+	my @args = split /,\s/, $argstr;
+	return $call(@args);
+}
+
+sub call_and_assign {
+	my $key = pop;
+	$stackref->{key} = call(@_);
+}
+
+sub push_loop {
+	my $key = shift;
+	push @loopstack, \$stackref->{$key};
+	$stackref = \$loopstack[$#loopstack];
+}
+
+sub pop_loop {
+	pop @loopstack;
+	$stackref = \$loopstack[$#loopstack];
+}
+
+sub if_handler {
+	my $key = shift;
+	if (!$stackref->{$key}){
+		while ($line !~ /^(\s*FI\s*|\s*END\s+IF\s*)$/ ){
+			$line = <>;
+		}
 	}
 }
 
+sub login {
+	$myconfig = new LedgerSMB::User 
+		"${LedgerSMB::Sysconfig::memberfile}", "$form->{login}";
+}
+
+sub load_mod {
+	my $mod = shift;
+	$mod =~ s/::/\//;
+	eval { require "$mod.pm"; };
+}
+
+my $scriptparse = new Parse::RecDescent($grammer);
+
+while ($line = <>){
+	$scriptparse->instruction($line);
+}
+
 delete $form->{password};
 
 for (keys %$form){