diff options
| -rw-r--r-- | utils/cli/ledgersmb_cli.pl | 130 |
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){ |