summaryrefslogtreecommitdiff
path: root/utils/cli/ledgersmb_cli.pl
diff options
context:
space:
mode:
Diffstat (limited to 'utils/cli/ledgersmb_cli.pl')
-rw-r--r--utils/cli/ledgersmb_cli.pl132
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";
}