summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--utils/cli/ledgersmb_cli.pl130
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){