5 use 5.008; # too much magic in here to include perl 5.6
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.
13 use Devel::REPL 1.002001;
19 SL::LxOfficeConf->read;
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);
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,
38 pod2usage(2) if !$result;
39 pod2usage(1) if $help;
40 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
42 # will be configed eventually
43 my @plugins = qw(History LexEnv Colors MultiLine::PPI FancyPrompt PermanentHistory AutoloadModules);
46 my ($repl, $code) = @_;
48 my $result = $repl->eval($code);
49 if (ref($result) eq 'Devel::REPL::Error') {
50 $repl->print($result->message);
61 my $repl = Devel::REPL->new;
62 $repl->load_plugin($_) for @plugins;
63 $repl->load_history($history_file);
65 $repl->print("trying to auto login into client '$client' with login '$login'...\n");
66 execute_code($repl, "lxinit '$client', '$login'");
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;
77 use CGI qw( -no_xhtml);
81 use SL::Helper::DateTime;
82 use SL::InstanceConfiguration;
86 use List::Util qw(max);
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.
94 my ($client, $login) = @_;
96 die 'need client and login' unless $client && $login;
100 $::lxdebug = LXDebug->new(file => $debug_file);
101 $::locale = Locale->new($::lx_office_conf{system}->{language});
103 $::auth = SL::Auth->new;
104 die "Cannot find client with ID or name '$client'" if !$::auth->set_client($client);
106 $::instance_conf = SL::InstanceConfiguration->new;
107 $::request = SL::Request->new(
109 layout => SL::Layout::None->new,
112 die 'cannot reach auth db' unless $::auth->session_tables_present;
114 $::auth->restore_session;
116 require "bin/mozilla/common.pl";
118 die "cannot find user $login" unless %::myconfig = $::auth->read_user(login => $login);
120 $::form->{login} = $login; # normaly implicit at login
122 die "cannot find locale for user $login" unless $::locale = Locale->new($::myconfig{countrycode});
124 $::instance_conf->init;
126 return "logged in as $login";
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
133 $module =~ s/[^\w]//g;
134 require "bin/mozilla/$module.pl";
138 require Module::Reload;
139 Module::Reload->check();
141 return "modules reloaded";
153 ./scripts/console [login]
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
164 part - shortcuts auf die jeweilige SL::DB::{...}::find_by
171 # load 'module' - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm.
175 local $Data::Dumper::Indent = 2;
176 local $Data::Dumper::Maxdepth = 2;
177 local $Data::Dumper::Sortkeys = 1;
178 Data::Dumper::Dumper(@_);
182 my @rows = ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
183 return '<empty result set>' unless @rows;
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;
191 return join("\n", @output);
196 return '<no object>' unless $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;
204 return "<${ref} " . join(' ', @columns) . '>';
208 my $dbh = ref($_[0]) ? shift : $::form->get_standard_dbh;
209 my ($query, @args) = @_;
211 if ($query =~ m/^\s*select/i) {
212 ptab($dbh->selectall_arrayref($query, { Slice => {} }, @args));
214 $dbh->do($query, { Slice => {} }, @args);
219 require SL::DB::Part;
220 SL::DB::Manager::Part->find_by(@_)
224 require SL::DB::Order;
225 SL::DB::Manager::Order->find_by(@_)
229 require SL::DB::Invoice;
230 SL::DB::Manager::Invoice->find_by(@_)
233 sub purchase_invoice {
234 require SL::DB::PurchaseInvoice;
235 SL::DB::Manager::PurchaseInvoice->find_by(@_)
239 require SL::DB::Customer;
240 SL::DB::Manager::Customer->find_by(@_)
244 require SL::DB::Vendor;
245 SL::DB::Manager::Vendor->find_by(@_)
249 require SL::DB::Chart;
250 SL::DB::Manager::Chart->find_by(@_)
254 my $s = [Time::HiRes::gettimeofday()];
256 Time::HiRes::tv_interval($s);
266 scripts/console - kivitendo console
270 ./script/console [options]
271 > help # displays a brief documentation
275 The list of supported command line options includes:
279 =item B<--help>, B<-h>
281 Print this help message and exit.
285 Print the manual page and exit.
287 =item B<-l>, B<--login>=C<username>
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.
292 =item B<-o>, B<--log-file>=C<filename>
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
298 =item B<-i>, B<--history-file>=C<filename>
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.
304 =item B<-e>, B<--execute>=C<perl-code>
306 Execute this code on startup and exit afterwards.
308 =item B<-f>, B<--file>=C<filename>
310 Execute the code from the file C<filename> on startup and exit
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.
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
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.
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.
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.
344 Undefined values are represented by an empty column.
348 ptab($dbh->selectall_arrayref("SELECT * FROM employee", { Slice => {} }));
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.
356 Undefined values are represented by C<UNDEF>.
360 pobj(SL::DB::Manager::Employee->find_by(login => 'demo'));
362 =head2 sql C<[ $dbh, ] $query, @bind_values>
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.
368 If the query is a C<SELECT> then the result is filtered through
369 L<ptab()>. Otherwise the result of C<$dbh->do($query, undef, @bind_values)>
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');
379 =head2 lxinit C<login>
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
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.
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.
400 Configuration of this script is located in:
402 config/kivitendo.conf
403 config/kivitendo.conf.default
405 See there for interesting options.
409 Sven Schöling <s.schoeling@linet-services.de>