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