BankTransaction: vergessene Textübersetzung bei Buchung erstellen
[kivitendo-erp.git] / scripts / console
1 #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5 use utf8;
6 use open qw(:std :utf8);
7 use 5.008;                          # too much magic in here to include perl 5.6
8
9 BEGIN {
10   use FindBin;
11
12   unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML).
13   push   (@INC, $FindBin::Bin . '/..');
14   push   (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version.
15 }
16
17 use Data::Dumper;
18 use Devel::REPL 1.002001;
19 use File::Slurp;
20 use Getopt::Long;
21 use Pod::Usage;
22
23 use SL::LxOfficeConf;
24 SL::LxOfficeConf->read;
25
26 my $client       = $::lx_office_conf{console}{client};
27 my $login        = $::lx_office_conf{console}{login}        || 'demo';
28 my $history_file = $::lx_office_conf{console}{history_file} || '/tmp/kivitendo_console_history.log'; # fallback if users is not writable
29 my $debug_file   = $::lx_office_conf{console}{log_file}     || '/tmp/kivitendo_console_debug.log';
30 my $autorun      = $::lx_office_conf{console}{autorun};
31 my ($execute_code, $execute_file, $help, $man);
32
33 my $result = GetOptions(
34   "login|l=s"        => \$login,
35   "client|c=s"       => \$client,
36   "history-file|i=s" => \$history_file,
37   "log-file|o=s"     => \$debug_file,
38   "execute|e=s"      => \$execute_code,
39   "file|f=s"         => \$execute_file,
40   "help|h"           => \$help,
41   "man"              => \$man,
42 );
43 pod2usage(2)                               if !$result;
44 pod2usage(1)                               if $help;
45 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
46
47 # will be configed eventually
48 my @plugins      = qw(History LexEnv Colors MultiLine::PPI FancyPrompt PermanentHistory AutoloadModules);
49
50 sub execute_code {
51   my ($repl, $code) = @_;
52
53   my $result = $repl->eval($code);
54   if (ref($result) eq 'Devel::REPL::Error') {
55     $repl->print($result->message);
56     return 0;
57   }
58   if ($@) {
59     $repl->print($@);
60     return 0;
61   }
62
63   return 1;
64 }
65
66 my $repl = Devel::REPL->new;
67 $repl->load_plugin($_) for @plugins;
68 $repl->load_history($history_file);
69
70 binmode($repl->out_fh, 'utf8');
71
72 $repl->eval('use utf8;');
73 $repl->eval('help');
74 $repl->print("trying to auto login into client '$client' with login '$login'...\n");
75 execute_code($repl, "lxinit '$client', '$login'");
76
77 my @code_to_execute = grep { $_ } ($autorun, $execute_code, $execute_file ? join('', read_file($execute_file)) : undef);
78 execute_code($repl, $_) || exit 1 for @code_to_execute;
79 exit  if $execute_code || $execute_file;
80
81 $repl->run;
82
83 package Devel::REPL;
84
85 use utf8;
86 use CGI qw( -no_xhtml);
87 use DateTime;
88 use SL::Auth;
89 use SL::Form;
90 use SL::Helper::DateTime;
91 use SL::InstanceConfiguration;
92 use SL::Locale;
93 use SL::LXDebug;
94 use Data::Dumper;
95 use List::Util qw(max);
96 use Time::HiRes;
97
98 # this is a cleaned up version of am.pl
99 # it lacks redirection, some html setup and most of the authentication process.
100 # it is assumed that anyone with physical access and execution rights on this script
101 # won't be hindered by authentication anyway.
102 sub lxinit {
103   my ($client, $login) = @_;
104
105   die 'need client and login' unless $client && $login;
106
107   package main;
108
109   $::lxdebug       = LXDebug->new(file => $debug_file);
110   $::locale        = Locale->new($::lx_office_conf{system}->{language});
111   $::form          = Form->new;
112   $::auth          = SL::Auth->new;
113   die "Cannot find client with ID or name '$client'" if !$::auth->set_client($client);
114
115   $::instance_conf = SL::InstanceConfiguration->new;
116   $::request       = SL::Request->new(
117     cgi    => CGI->new({}),
118     layout => SL::Layout::None->new,
119   );
120
121   die 'cannot reach auth db'               unless $::auth->session_tables_present;
122
123   $::auth->restore_session;
124
125   require "bin/mozilla/common.pl";
126
127   die "cannot find user $login"            unless %::myconfig = $::auth->read_user(login => $login);
128
129   die "cannot find locale for user $login" unless $::locale   = Locale->new($::myconfig{countrycode});
130   $::myconfig{login} = $login; # so SL::DB::Manager::Employee->current works in test database
131
132   $::instance_conf->init;
133
134   return "logged in as $login";
135 }
136
137 # these function provides a load command to slurp in a lx-office module
138 # since it's seldomly useful, it's not documented in help
139 sub load {
140   my $module = shift;
141   $module =~ s/[^\w]//g;
142   require "bin/mozilla/$module.pl";
143 }
144
145 sub reload {
146   require Module::Reload;
147   Module::Reload->check();
148
149   return "modules reloaded";
150 }
151
152 sub quit {
153   exit;
154 }
155
156 sub help {
157   print <<EOL;
158
159   kivitendo Konsole
160
161   ./scripts/console [login]
162
163 Spezielle Kommandos:
164
165   help              - zeigt diese Hilfe an.
166   lxinit 'login'    - lädt das kivitendo-Environment für den User 'login'.
167   reload            - lädt modifizierte Module neu.
168   pp DATA           - zeigt die Datenstruktur mit Data::Dumper an.
169   clock { CODE }    - zeigt die gebrauchte Zeit für die Ausführung von CODE an
170   quit              - beendet die Konsole
171
172   part              - shortcuts auf die jeweilige SL::DB::{...}::find_by
173   customer, vendor,
174   order, invoice,
175   purchase_invoice,
176   chart
177
178 EOL
179 #  load   'module'     - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm.
180 }
181
182 sub pp {
183   local $Data::Dumper::Indent   = 2;
184   local $Data::Dumper::Maxdepth = 2;
185   local $Data::Dumper::Sortkeys = 1;
186   Data::Dumper::Dumper(@_);
187 }
188
189 sub ptab {
190   my @rows = ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
191   return '<empty result set>' unless @rows;
192
193   my @columns = sort keys %{ $rows[0] };
194   my @widths  = map { max @{ $_ } } map { my $column = $_; [ length($column), map { length("" . ($_->{$column} // '')) } @rows ] } @columns;
195   my @output  = (join ' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $columns[$_] } (0..@columns - 1));
196   push @output, join('-+-', map { '-' x $_ } @widths);
197   push @output, map { my $row = $_; join(' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $row->{ $columns[$_] } // '' } (0..@columns - 1) ) } @rows;
198
199   return join("\n", @output);
200 }
201
202 sub pobj {
203   my ($obj) = @_;
204   return '<no object>' unless $obj;
205
206   my $ref        =  ref $obj;
207   $ref           =~ s/^SL::DB:://;
208   my %primaries  =  map { ($_ => 1) } $obj->meta->primary_key;
209   my @columns    =  map { "${_}:" . ($obj->$_ // 'UNDEF') } sort $obj->meta->primary_key;
210   push @columns,    map { "${_}:" . ($obj->$_ // 'UNDEF') } grep { !$primaries{$_} } sort map { $_->{name} } $obj->meta->columns;
211
212   return "<${ref} " . join(' ', @columns) . '>';
213 }
214
215 sub sql {
216   my $dbh            = ref($_[0]) ? shift : $::form->get_standard_dbh;
217   my ($query, @args) = @_;
218
219   if ($query =~ m/^\s*select/i) {
220     ptab($dbh->selectall_arrayref($query, { Slice => {} }, @args));
221   } else {
222     $dbh->do($query, { Slice => {} }, @args);
223   }
224 }
225
226 sub part {
227   require SL::DB::Part;
228   SL::DB::Manager::Part->find_by(@_)
229 }
230
231 sub order {
232   require SL::DB::Order;
233   SL::DB::Manager::Order->find_by(@_)
234 }
235
236 sub invoice {
237   require SL::DB::Invoice;
238   SL::DB::Manager::Invoice->find_by(@_)
239 }
240
241 sub purchase_invoice {
242   require SL::DB::PurchaseInvoice;
243   SL::DB::Manager::PurchaseInvoice->find_by(@_)
244 }
245
246 sub customer {
247   require SL::DB::Customer;
248   SL::DB::Manager::Customer->find_by(@_)
249 }
250
251 sub vendor {
252   require SL::DB::Vendor;
253   SL::DB::Manager::Vendor->find_by(@_)
254 }
255
256 sub chart {
257   require SL::DB::Chart;
258   SL::DB::Manager::Chart->find_by(@_)
259 }
260
261 sub clock (&) {
262   my $s = [Time::HiRes::gettimeofday()];
263   $_[0]->();
264   Time::HiRes::tv_interval($s);
265 }
266
267
268 1;
269
270 __END__
271
272 =head1 NAME
273
274 scripts/console - kivitendo console
275
276 =head1 SYNOPSIS
277
278   ./script/console [options]
279   > help               # displays a brief documentation
280
281 =head1 OPTIONS
282
283 The list of supported command line options includes:
284
285 =over 8
286
287 =item B<--help>, B<-h>
288
289 Print this help message and exit.
290
291 =item B<--man>
292
293 Print the manual page and exit.
294
295 =item B<-l>, B<--login>=C<username>
296
297 Log in as C<username>. The default is to use the value from the
298 configuration file and C<demo> if none is set there.
299
300 =item B<-c>, B<--client>=C<client>
301
302 Use the database for client C<client>. C<client> can be a client's
303 database ID or its name. The default is to use the value from the
304 configuration file.
305
306 =item B<-o>, B<--log-file>=C<filename>
307
308 Use C<filename> as the log file. The default is to use the value from
309 the configuration file and C</tmp/kivitendo_console_debug.log> if none
310 is set there.
311
312 =item B<-i>, B<--history-file>=C<filename>
313
314 Use C<filename> as the history file for commands input by the
315 user. The default is to use the value from the configuration file and
316 C</tmp/kivitendo_console_history.log> if none is set there.
317
318 =item B<-e>, B<--execute>=C<perl-code>
319
320 Execute this code on startup and exit afterwards.
321
322 =item B<-f>, B<--file>=C<filename>
323
324 Execute the code from the file C<filename> on startup and exit
325 afterwards.
326
327 =back
328
329 =head1 DESCRIPTION
330
331 Users of Ruby on Rails will recognize this as a perl reimplementation of the
332 rails scripts/console. It's intend is to provide a shell environment to the
333 lx-office internals. This will mostly not interest you if you just want to do
334 your ERP stuff with lx-office, but will be invaluable for those who wish to
335 make changes to lx-office itself.
336
337 =head1 FUNCTIONS
338
339 You can do most things in the console that you could do in an actual perl
340 script. Certain helper functions will aid you in debugging the state of the
341 program:
342
343 =head2 pp C<DATA>
344
345 Named after the rails pretty print gem, this will call Data::Dumper on the
346 given C<DATA>. Use it to see what is going on.
347
348 Currently C<pp> will set the Data::Dumper depth to 2, so if you need a
349 different depth, you'll have to change that. A nice feature would be to
350 configure that, or at least to be able to change it at runtime.
351
352 =head2 ptab C<@data>
353
354 Returns a tabular representation of C<@data>. C<@data> must be an
355 array or array reference containing hash references. Column widths are
356 calculated automatically.
357
358 Undefined values are represented by an empty column.
359
360 Example usage:
361
362     ptab($dbh->selectall_arrayref("SELECT * FROM employee", { Slice => {} }));
363
364 =head2 pobj C<$obj>
365
366 Returns a textual representation of the L<Rose::DB> instance
367 C<$obj>. This includes the class name, then the primary key columns as
368 name/value pairs and then all other columns as name/value pairs.
369
370 Undefined values are represented by C<UNDEF>.
371
372 Example usage:
373
374     pobj(SL::DB::Manager::Employee->find_by(login => 'demo'));
375
376 =head2 sql C<[ $dbh, ] $query, @bind_values>
377
378 Executes an SQL query using the optional bind values. If the first
379 parameter is a database handle then that database handle is used;
380 otherwise the handle returned by L<SL::Form/get_standard_dbh> is used.
381
382 If the query is a C<SELECT> then the result is filtered through
383 L<ptab()>. Otherwise the result of C<$dbh-&gt;do($query, undef, @bind_values)>
384 is returned.
385
386 Example usage:
387
388     sql(qq|SELECT * FROM employee|);
389     sql(SL::DB::Employee->new->db->dbh,
390         qq|UPDATE employee SET notes = ? WHERE login = ?|,
391         'This guy is evil!', 'demo');
392
393 =head2 lxinit C<login>
394
395 Login into lx-office using a specified login. No password will be required, and
396 security mechanisms will mostly be inactive. form, locale, myconfig will be
397 correctly set.
398
399 =head2 reload
400
401 Attempts to reload modules that changed since last reload (or inital startup).
402 This will mostly work just fine, except for Moose classes that have been made
403 immutable. Keep in mind that existing objects will continue to have the methods
404 of the classes they were created with.
405
406 =head1 BUGS
407
408  - Reload on immutable Moose classes is buggy.
409  - Logging in more than once is not supported by the program, and thus not by
410    the console. It seems to work, but strange things may happen.
411
412 =head1 SEE ALSO
413
414 Configuration of this script is located in:
415
416  config/kivitendo.conf
417  config/kivitendo.conf.default
418
419 See there for interesting options.
420
421 =head1 AUTHOR
422
423   Sven Schöling <s.schoeling@linet-services.de>
424
425 =cut