console: clock Funktion um kleionere Schnipsel timen zu können
[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   $::form->{login} = $login; # normaly implicit at login
121
122   die "cannot find locale for user $login" unless $::locale   = Locale->new($::myconfig{countrycode});
123
124   $::instance_conf->init;
125
126   return "logged in as $login";
127 }
128
129 # these function provides a load command to slurp in a lx-office module
130 # since it's seldomly useful, it's not documented in help
131 sub load {
132   my $module = shift;
133   $module =~ s/[^\w]//g;
134   require "bin/mozilla/$module.pl";
135 }
136
137 sub reload {
138   require Module::Reload;
139   Module::Reload->check();
140
141   return "modules reloaded";
142 }
143
144 sub quit {
145   exit;
146 }
147
148 sub help {
149   print <<EOL;
150
151   kivitendo Konsole
152
153   ./scripts/console [login]
154
155 Spezielle Kommandos:
156
157   help              - zeigt diese Hilfe an.
158   lxinit 'login'    - lädt das kivitendo-Environment für den User 'login'.
159   reload            - lädt modifizierte Module neu.
160   pp DATA           - zeigt die Datenstruktur mit Data::Dumper an.
161   clock { CODE }    - zeigt die gebrauchte Zeit für die Ausführung von CODE an
162   quit              - beendet die Konsole
163
164   part              - shortcuts auf die jeweilige SL::DB::{...}::find_by
165   customer, vendor,
166   order, invoice,
167   purchase_invoice,
168   chart
169
170 EOL
171 #  load   'module'     - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm.
172 }
173
174 sub pp {
175   local $Data::Dumper::Indent   = 2;
176   local $Data::Dumper::Maxdepth = 2;
177   local $Data::Dumper::Sortkeys = 1;
178   Data::Dumper::Dumper(@_);
179 }
180
181 sub ptab {
182   my @rows = ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
183   return '<empty result set>' unless @rows;
184
185   my @columns = sort keys %{ $rows[0] };
186   my @widths  = map { max @{ $_ } } map { my $column = $_; [ length($column), map { length("" . ($_->{$column} // '')) } @rows ] } @columns;
187   my @output  = (join ' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $columns[$_] } (0..@columns - 1));
188   push @output, join('-+-', map { '-' x $_ } @widths);
189   push @output, map { my $row = $_; join(' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $row->{ $columns[$_] } // '' } (0..@columns - 1) ) } @rows;
190
191   return join("\n", @output);
192 }
193
194 sub pobj {
195   my ($obj) = @_;
196   return '<no object>' unless $obj;
197
198   my $ref        =  ref $obj;
199   $ref           =~ s/^SL::DB:://;
200   my %primaries  =  map { ($_ => 1) } $obj->meta->primary_key;
201   my @columns    =  map { "${_}:" . ($obj->$_ // 'UNDEF') } sort $obj->meta->primary_key;
202   push @columns,    map { "${_}:" . ($obj->$_ // 'UNDEF') } grep { !$primaries{$_} } sort map { $_->{name} } $obj->meta->columns;
203
204   return "<${ref} " . join(' ', @columns) . '>';
205 }
206
207 sub sql {
208   my $dbh            = ref($_[0]) ? shift : $::form->get_standard_dbh;
209   my ($query, @args) = @_;
210
211   if ($query =~ m/^\s*select/i) {
212     ptab($dbh->selectall_arrayref($query, { Slice => {} }, @args));
213   } else {
214     $dbh->do($query, { Slice => {} }, @args);
215   }
216 }
217
218 sub part {
219   require SL::DB::Part;
220   SL::DB::Manager::Part->find_by(@_)
221 }
222
223 sub order {
224   require SL::DB::Order;
225   SL::DB::Manager::Order->find_by(@_)
226 }
227
228 sub invoice {
229   require SL::DB::Invoice;
230   SL::DB::Manager::Invoice->find_by(@_)
231 }
232
233 sub purchase_invoice {
234   require SL::DB::PurchaseInvoice;
235   SL::DB::Manager::PurchaseInvoice->find_by(@_)
236 }
237
238 sub customer {
239   require SL::DB::Customer;
240   SL::DB::Manager::Customer->find_by(@_)
241 }
242
243 sub vendor {
244   require SL::DB::Vendor;
245   SL::DB::Manager::Vendor->find_by(@_)
246 }
247
248 sub chart {
249   require SL::DB::Chart;
250   SL::DB::Manager::Chart->find_by(@_)
251 }
252
253 sub clock (&) {
254   my $s = [Time::HiRes::gettimeofday()];
255   $_[0]->();
256   Time::HiRes::tv_interval($s);
257 }
258
259
260 1;
261
262 __END__
263
264 =head1 NAME
265
266 scripts/console - kivitendo console
267
268 =head1 SYNOPSIS
269
270   ./script/console [options]
271   > help               # displays a brief documentation
272
273 =head1 OPTIONS
274
275 The list of supported command line options includes:
276
277 =over 8
278
279 =item B<--help>, B<-h>
280
281 Print this help message and exit.
282
283 =item B<--man>
284
285 Print the manual page and exit.
286
287 =item B<-l>, B<--login>=C<username>
288
289 Log in as C<username>. The default is to use the value from the
290 configuration file and C<demo> if none is set there.
291
292 =item B<-o>, B<--log-file>=C<filename>
293
294 Use C<filename> as the log file. The default is to use the value from
295 the configuration file and C</tmp/kivitendo_console_debug.log> if none
296 is set there.
297
298 =item B<-i>, B<--history-file>=C<filename>
299
300 Use C<filename> as the history file for commands input by the
301 user. The default is to use the value from the configuration file and
302 C</tmp/kivitendo_console_history.log> if none is set there.
303
304 =item B<-e>, B<--execute>=C<perl-code>
305
306 Execute this code on startup and exit afterwards.
307
308 =item B<-f>, B<--file>=C<filename>
309
310 Execute the code from the file C<filename> on startup and exit
311 afterwards.
312
313 =back
314
315 =head1 DESCRIPTION
316
317 Users of Ruby on Rails will recognize this as a perl reimplementation of the
318 rails scripts/console. It's intend is to provide a shell environment to the
319 lx-office internals. This will mostly not interest you if you just want to do
320 your ERP stuff with lx-office, but will be invaluable for those who wish to
321 make changes to lx-office itself.
322
323 =head1 FUNCTIONS
324
325 You can do most things in the console that you could do in an actual perl
326 script. Certain helper functions will aid you in debugging the state of the
327 program:
328
329 =head2 pp C<DATA>
330
331 Named after the rails pretty print gem, this will call Data::Dumper on the
332 given C<DATA>. Use it to see what is going on.
333
334 Currently C<pp> will set the Data::Dumper depth to 2, so if you need a
335 different depth, you'll have to change that. A nice feature would be to
336 configure that, or at least to be able to change it at runtime.
337
338 =head2 ptab C<@data>
339
340 Returns a tabular representation of C<@data>. C<@data> must be an
341 array or array reference containing hash references. Column widths are
342 calculated automatically.
343
344 Undefined values are represented by an empty column.
345
346 Example usage:
347
348     ptab($dbh->selectall_arrayref("SELECT * FROM employee", { Slice => {} }));
349
350 =head2 pobj C<$obj>
351
352 Returns a textual representation of the L<Rose::DB> instance
353 C<$obj>. This includes the class name, then the primary key columns as
354 name/value pairs and then all other columns as name/value pairs.
355
356 Undefined values are represented by C<UNDEF>.
357
358 Example usage:
359
360     pobj(SL::DB::Manager::Employee->find_by(login => 'demo'));
361
362 =head2 sql C<[ $dbh, ] $query, @bind_values>
363
364 Executes an SQL query using the optional bind values. If the first
365 parameter is a database handle then that database handle is used;
366 otherwise the handle returned by L<SL::Form/get_standard_dbh> is used.
367
368 If the query is a C<SELECT> then the result is filtered through
369 L<ptab()>. Otherwise the result of C<$dbh-&gt;do($query, undef, @bind_values)>
370 is returned.
371
372 Example usage:
373
374     sql(qq|SELECT * FROM employee|);
375     sql(SL::DB::Employee->new->db->dbh,
376         qq|UPDATE employee SET notes = ? WHERE login = ?|,
377         'This guy is evil!', 'demo');
378
379 =head2 lxinit C<login>
380
381 Login into lx-office using a specified login. No password will be required, and
382 security mechanisms will mostly be inactive. form, locale, myconfig will be
383 correctly set.
384
385 =head2 reload
386
387 Attempts to reload modules that changed since last reload (or inital startup).
388 This will mostly work just fine, except for Moose classes that have been made
389 immutable. Keep in mind that existing objects will continue to have the methods
390 of the classes they were created with.
391
392 =head1 BUGS
393
394  - Reload on immutable Moose classes is buggy.
395  - Logging in more than once is not supported by the program, and thus not by
396    the console. It seems to work, but strange things may happen.
397
398 =head1 SEE ALSO
399
400 Configuration of this script is located in:
401
402  config/kivitendo.conf
403  config/kivitendo.conf.default
404
405 See there for interesting options.
406
407 =head1 AUTHOR
408
409   Sven Schöling <s.schoeling@linet-services.de>
410
411 =cut