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