summaryrefslogtreecommitdiff
path: root/utils/cli/ledgersmb_cli.pl
blob: 4bdd0d5fa8eecd96364dbd1b6a42d6d35306256a (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 $stackref;
  72. my @loopstack;
  73. push @loopstack, $form;
  74. sub assignval {
  75. my ($key, $value) = @_;
  76. if ($key =~ /^ENV:/i){
  77. $ENV{$key} = $value;
  78. } else {
  79. %{$loopstack[$#loopstack - 1]}->{$key} = $value;
  80. }
  81. }
  82. sub expression {
  83. shift;
  84. my ($lhs,$op,$rhs) = @_;
  85. $lhs = $VARIABLE{$lhs} if $lhs=~/[^-+0-9]/;
  86. return eval "$lhs $op $rhs";
  87. }
  88. sub call {
  89. my ($call, $argstr) = @_;
  90. $argstr =~ s/form/\\\%\$form/;
  91. $argstr =~ s/user/\\\%myconfig/;
  92. my @args = split /,\s/, $argstr;
  93. eval "$call($argstr);\n" || print STDERR $@ . "\n";
  94. }
  95. sub call_and_assign {
  96. my $key = pop;
  97. $stackref->{key} = call(@_);
  98. }
  99. sub push_loop {
  100. my $key = shift;
  101. push @loopstack, \$stackref->{$key};
  102. $stackref = \$loopstack[$#loopstack];
  103. }
  104. sub pop_loop {
  105. pop @loopstack;
  106. $stackref = \$loopstack[$#loopstack];
  107. }
  108. sub if_handler {
  109. my $key = shift;
  110. if (!$stackref->{$key}){
  111. $if_count = 1;
  112. }
  113. }
  114. sub login {
  115. $myconfig = new LedgerSMB::User
  116. "${LedgerSMB::Sysconfig::memberfile}", "$form->{login}";
  117. $form->db_init($myconfig);
  118. }
  119. sub load_mod {
  120. my $mod = shift;
  121. $mod =~ s/::/\//;
  122. require "$mod.pm";;
  123. }
  124. my $scriptparse = new Parse::RecDescent($syntax);
  125. while ($line = <>){
  126. if ($if_count){
  127. if ($line =~ /^\s*IF\s/){
  128. ++$if_count;
  129. }
  130. if ($line =~ /^(\s*FI\s*|\s*END\s+IF\s*)$/){
  131. --$if_count;
  132. }
  133. }
  134. next if ($if_count);
  135. $line =~ s/#.*$//; # strip comments
  136. $scriptparse->startrule($line);
  137. }
  138. delete $form->{password};
  139. for (keys %$form){
  140. print "$_ = $form->{$_}\n";
  141. }