diff options
Diffstat (limited to 'utils/cli')
-rw-r--r-- | utils/cli/ledgersmb_cli.pl | 132 |
1 files changed, 68 insertions, 64 deletions
diff --git a/utils/cli/ledgersmb_cli.pl b/utils/cli/ledgersmb_cli.pl index 67a1b8f4..69143520 100644 --- a/utils/cli/ledgersmb_cli.pl +++ b/utils/cli/ledgersmb_cli.pl @@ -4,15 +4,15 @@ # LedgerSMB Command-line script host # # -# LedgerSMB +# LedgerSMB # Small Medium Business Accounting software # http://www.ledgersmb.org/ -# +# # # Copyright (C) 2006 # This work contains copyrighted information from a number of sources all used -# with permission. It is released under the GNU General Public License -# Version 2 or, at your option, any later version. See COPYRIGHT file for +# with permission. It is released under the GNU General Public License +# Version 2 or, at your option, any later version. See COPYRIGHT file for # details. # # This is a simple wrapper that allows you to write simple scripts with LSMB @@ -83,9 +83,10 @@ $syntax = << '_END_SYNTAX_'; _END_SYNTAX_ - $::RD_HINT = 1; - $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error - $::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.` +$::RD_HINT = 1; +$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error +$::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.` + #$::RD_TRACE = 1; my @loopstack; my $loopindex; @@ -95,96 +96,99 @@ my @control_stack; push @loopstack, $form; sub assignval { - my ($key, $value) = @_; - if ($key =~ /^ENV:/i){ - $ENV{$key} = $value; - } else { - %{$loopstack[$#loopstack - 1]}->{$key} = $value; - } + my ( $key, $value ) = @_; + if ( $key =~ /^ENV:/i ) { + $ENV{$key} = $value; + } + else { + %{ $loopstack[ $#loopstack - 1 ] }->{$key} = $value; + } } sub expression { - shift; - my ($lhs,$op,$rhs) = @_; - $lhs = $VARIABLE{$lhs} if $lhs=~/[^-+0-9]/; - return eval "$lhs $op $rhs"; + shift; + my ( $lhs, $op, $rhs ) = @_; + $lhs = $VARIABLE{$lhs} if $lhs =~ /[^-+0-9]/; + return eval "$lhs $op $rhs"; } sub call { - my ($call, $argstr) = @_; - $argstr =~ s/form/\\\%\$form/; - $argstr =~ s/user/\\\%myconfig/; - my @args = split /,\s/, $argstr; - eval "$call($argstr);\n" || print STDERR $@ . "\n"; + my ( $call, $argstr ) = @_; + $argstr =~ s/form/\\\%\$form/; + $argstr =~ s/user/\\\%myconfig/; + my @args = split /,\s/, $argstr; + eval "$call($argstr);\n" || print STDERR $@ . "\n"; } sub call_and_assign { - my $key = pop; - $stackref->{key} = call(@_); + my $key = pop; + $stackref->{key} = call(@_); } sub push_loop { - my $key = shift; - my $is_hash = 0; - if (ref($stackref->{$key}) =~ /HASH/){ - $is_hash = 1; - } elsif (ref ($stackref->{$key}) !~ /ARRAY/){ - print STDERR "Warning: Must loop through array or hash."; - } - push @loopstack, \$stackref->{$key}; - push @controlstack, - { "key" => $key, - 'index' => 0, - 'linenum' => $#linestack, - is_hash => $is_hash }; + my $key = shift; + my $is_hash = 0; + if ( ref( $stackref->{$key} ) =~ /HASH/ ) { + $is_hash = 1; + } + elsif ( ref( $stackref->{$key} ) !~ /ARRAY/ ) { + print STDERR "Warning: Must loop through array or hash."; + } + push @loopstack, \$stackref->{$key}; + push @controlstack, + { + "key" => $key, + 'index' => 0, + 'linenum' => $#linestack, + is_hash => $is_hash + }; } sub pop_loop { - pop @loopstack; - $stackref = \$loopstack[$#loopstack]; + pop @loopstack; + $stackref = \$loopstack[$#loopstack]; } sub if_handler { - my $key = shift; - if (!$stackref->{$key}){ - $if_count = 1; - } + my $key = shift; + if ( !$stackref->{$key} ) { + $if_count = 1; + } } sub login { - $myconfig = new LedgerSMB::User("$form->{login}"); - $form->db_init($myconfig); + $myconfig = new LedgerSMB::User("$form->{login}"); + $form->db_init($myconfig); } sub load_mod { - my $mod = shift; - $mod =~ s/::/\//; - require "$mod.pm";; + my $mod = shift; + $mod =~ s/::/\//; + require "$mod.pm"; } my $scriptparse = new Parse::RecDescent($syntax); - $loopindex = 0; my @linestack; -while ($line = <>){ - push @linestack, $line; - if ($if_count){ - if ($line =~ /^\s*IF\s/){ - ++$if_count; - } - if ($line =~ /^(\s*FI\s*|\s*END\s+IF\s*)$/){ - --$if_count; - } - } - next if ($if_count); - $line =~ s/#.*$//; # strip comments - $scriptparse->startrule($line); +while ( $line = <> ) { + push @linestack, $line; + if ($if_count) { + if ( $line =~ /^\s*IF\s/ ) { + ++$if_count; + } + if ( $line =~ /^(\s*FI\s*|\s*END\s+IF\s*)$/ ) { + --$if_count; + } + } + next if ($if_count); + $line =~ s/#.*$//; # strip comments + $scriptparse->startrule($line); } delete $form->{password}; -for (keys %$form){ - print "$_ = $form->{$_}\n"; +for ( keys %$form ) { + print "$_ = $form->{$_}\n"; } |