summaryrefslogtreecommitdiff
path: root/utils/cli/ledgersmb_cli.pl
blob: 67a1b8f4ab9edab6c53f3e4f1ab89cc6c381aea0 (plain)
  1. #!/usr/bin/perl
  2. #===========================================================================
  3. #
  4. # LedgerSMB Command-line script host
  5. #
  6. #
  7. # LedgerSMB
  8. # Small Medium Business Accounting software
  9. # http://www.ledgersmb.org/
  10. #
  11. #
  12. # Copyright (C) 2006
  13. # This work contains copyrighted information from a number of sources all used
  14. # with permission. It is released under the GNU General Public License
  15. # Version 2 or, at your option, any later version. See COPYRIGHT file for
  16. # details.
  17. #
  18. # This is a simple wrapper that allows you to write simple scripts with LSMB
  19. # See sample for the file format.
  20. #
  21. # THIS IS EXPERIMENTAL AND THE INTERFACE IS SUBJECT TO CHANGE
  22. use Parse::RecDescent;
  23. use LedgerSMB::User;
  24. use LedgerSMB::Form;
  25. use LedgerSMB::Sysconfig;
  26. $form = new Form;
  27. $syntax = << '_END_SYNTAX_';
  28. KEY : /\w[a-z0-9_]*/i
  29. MODSTR : /\w[a-z0-9_:]*/i
  30. FNKEY : /(?:\w|:|\-\>)+/
  31. OP : m([-+*/%])
  32. NUMBER : /[+-]?\d*\.?\d+/
  33. ARGS : /(\w[a-z0-9_]*,?\s?)+/i
  34. expression : NUMBER OP expression
  35. { return main::expression(@item) }
  36. | KEY OP expression
  37. { return main::expression(@item) }
  38. | NUMBER
  39. | KEY
  40. assign_instruction : KEY "=" expression
  41. { main::assignval($item{KEY}, $item{expression}) }
  42. call_and_assign : /call/i FNKEY '(' ARGS ')' /into/i KEY
  43. { main::call_and_assign($item{FNKEY}, $item{ARGSTR}, $item{KEY}) }
  44. FUNCTIONCALL : /call/i FNKEY '(' ARGS ')'
  45. { main::call($item{FNKEY}, $item{ARGS});}
  46. for : /for/i KEY
  47. { main::push_loop($item{KEY}) }
  48. done : /^\s*done\s*$/
  49. { main::pop_loop() }
  50. if : /^\s*if/i KEY
  51. { main::if_handler($item{KEY}) }
  52. # IF is terminated by END IF or FI on its own line
  53. login : /login/i
  54. { main::login() }
  55. module : /module/i MODSTR
  56. { main::load_mod($item{MODSTR}) }
  57. instruction : assign_instruction
  58. | call_and_assign
  59. | FUNCTIONCALL
  60. | for
  61. | done
  62. | if
  63. | login
  64. | module
  65. startrule : instruction
  66. _END_SYNTAX_
  67. $::RD_HINT = 1;
  68. $::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
  69. $::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c.`
  70. #$::RD_TRACE = 1;
  71. my @loopstack;
  72. my $loopindex;
  73. my $stackref;
  74. my @control_stack;
  75. push @loopstack, $form;
  76. sub assignval {
  77. my ($key, $value) = @_;
  78. if ($key =~ /^ENV:/i){
  79. $ENV{$key} = $value;
  80. } else {
  81. %{$loopstack[$#loopstack - 1]}->{$key} = $value;
  82. }
  83. }
  84. sub expression {
  85. shift;
  86. my ($lhs,$op,$rhs) = @_;
  87. $lhs = $VARIABLE{$lhs} if $lhs=~/[^-+0-9]/;
  88. return eval "$lhs $op $rhs";
  89. }
  90. sub call {
  91. my ($call, $argstr) = @_;
  92. $argstr =~ s/form/\\\%\$form/;
  93. $argstr =~ s/user/\\\%myconfig/;
  94. my @args = split /,\s/, $argstr;
  95. eval "$call($argstr);\n" || print STDERR $@ . "\n";
  96. }
  97. sub call_and_assign {
  98. my $key = pop;
  99. $stackref->{key} = call(@_);
  100. }
  101. sub push_loop {
  102. my $key = shift;
  103. my $is_hash = 0;
  104. if (ref($stackref->{$key}) =~ /HASH/){
  105. $is_hash = 1;
  106. } elsif (ref ($stackref->{$key}) !~ /ARRAY/){
  107. print STDERR "Warning: Must loop through array or hash.";
  108. }
  109. push @loopstack, \$stackref->{$key};
  110. push @controlstack,
  111. { "key" => $key,
  112. 'index' => 0,
  113. 'linenum' => $#linestack,
  114. is_hash => $is_hash };
  115. }
  116. sub pop_loop {
  117. pop @loopstack;
  118. $stackref = \$loopstack[$#loopstack];
  119. }
  120. sub if_handler {
  121. my $key = shift;
  122. if (!$stackref->{$key}){
  123. $if_count = 1;
  124. }
  125. }
  126. sub login {
  127. $myconfig = new LedgerSMB::User("$form->{login}");
  128. $form->db_init($myconfig);
  129. }
  130. sub load_mod {
  131. my $mod = shift;
  132. $mod =~ s/::/\//;
  133. require "$mod.pm";;
  134. }
  135. my $scriptparse = new Parse::RecDescent($syntax);
  136. $loopindex = 0;
  137. my @linestack;
  138. while ($line = <>){
  139. push @linestack, $line;
  140. if ($if_count){
  141. if ($line =~ /^\s*IF\s/){
  142. ++$if_count;
  143. }
  144. if ($line =~ /^(\s*FI\s*|\s*END\s+IF\s*)$/){
  145. --$if_count;
  146. }
  147. }
  148. next if ($if_count);
  149. $line =~ s/#.*$//; # strip comments
  150. $scriptparse->startrule($line);
  151. }
  152. delete $form->{password};
  153. for (keys %$form){
  154. print "$_ = $form->{$_}\n";
  155. }