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 die "cannot find locale for user $login" unless $::locale = Locale->new($::myconfig{countrycode});
121 $::myconfig{login} = $login; # so SL::DB::Manager::Employee->current works in test database
123 $::instance_conf->init;
125 return "logged in as $login";
128 # these function provides a load command to slurp in a lx-office module
129 # since it's seldomly useful, it's not documented in help
132 $module =~ s/[^\w]//g;
133 require "bin/mozilla/$module.pl";
137 require Module::Reload;
138 Module::Reload->check();
140 return "modules reloaded";
152 ./scripts/console [login]
156 help - zeigt diese Hilfe an.
157 lxinit 'login' - lädt das kivitendo-Environment für den User 'login'.
158 reload - lädt modifizierte Module neu.
159 pp DATA - zeigt die Datenstruktur mit Data::Dumper an.
160 clock { CODE } - zeigt die gebrauchte Zeit für die Ausführung von CODE an
161 quit - beendet die Konsole
163 part - shortcuts auf die jeweilige SL::DB::{...}::find_by
170 # load 'module' - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm.
174 local $Data::Dumper::Indent = 2;
175 local $Data::Dumper::Maxdepth = 2;
176 local $Data::Dumper::Sortkeys = 1;
177 Data::Dumper::Dumper(@_);
181 my @rows = ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
182 return '<empty result set>' unless @rows;
184 my @columns = sort keys %{ $rows[0] };
185 my @widths = map { max @{ $_ } } map { my $column = $_; [ length($column), map { length("" . ($_->{$column} // '')) } @rows ] } @columns;
186 my @output = (join ' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $columns[$_] } (0..@columns - 1));
187 push @output, join('-+-', map { '-' x $_ } @widths);
188 push @output, map { my $row = $_; join(' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $row->{ $columns[$_] } // '' } (0..@columns - 1) ) } @rows;
190 return join("\n", @output);
195 return '<no object>' unless $obj;
198 $ref =~ s/^SL::DB:://;
199 my %primaries = map { ($_ => 1) } $obj->meta->primary_key;
200 my @columns = map { "${_}:" . ($obj->$_ // 'UNDEF') } sort $obj->meta->primary_key;
201 push @columns, map { "${_}:" . ($obj->$_ // 'UNDEF') } grep { !$primaries{$_} } sort map { $_->{name} } $obj->meta->columns;
203 return "<${ref} " . join(' ', @columns) . '>';
207 my $dbh = ref($_[0]) ? shift : $::form->get_standard_dbh;
208 my ($query, @args) = @_;
210 if ($query =~ m/^\s*select/i) {
211 ptab($dbh->selectall_arrayref($query, { Slice => {} }, @args));
213 $dbh->do($query, { Slice => {} }, @args);
218 require SL::DB::Part;
219 SL::DB::Manager::Part->find_by(@_)
223 require SL::DB::Order;
224 SL::DB::Manager::Order->find_by(@_)
228 require SL::DB::Invoice;
229 SL::DB::Manager::Invoice->find_by(@_)
232 sub purchase_invoice {
233 require SL::DB::PurchaseInvoice;
234 SL::DB::Manager::PurchaseInvoice->find_by(@_)
238 require SL::DB::Customer;
239 SL::DB::Manager::Customer->find_by(@_)
243 require SL::DB::Vendor;
244 SL::DB::Manager::Vendor->find_by(@_)
248 require SL::DB::Chart;
249 SL::DB::Manager::Chart->find_by(@_)
253 my $s = [Time::HiRes::gettimeofday()];
255 Time::HiRes::tv_interval($s);
265 scripts/console - kivitendo console
269 ./script/console [options]
270 > help # displays a brief documentation
274 The list of supported command line options includes:
278 =item B<--help>, B<-h>
280 Print this help message and exit.
284 Print the manual page and exit.
286 =item B<-l>, B<--login>=C<username>
288 Log in as C<username>. The default is to use the value from the
289 configuration file and C<demo> if none is set there.
291 =item B<-c>, B<--client>=C<client>
293 Use the database for client C<client>. C<client> can be a client's
294 database ID or its name. The default is to use the value from the
297 =item B<-o>, B<--log-file>=C<filename>
299 Use C<filename> as the log file. The default is to use the value from
300 the configuration file and C</tmp/kivitendo_console_debug.log> if none
303 =item B<-i>, B<--history-file>=C<filename>
305 Use C<filename> as the history file for commands input by the
306 user. The default is to use the value from the configuration file and
307 C</tmp/kivitendo_console_history.log> if none is set there.
309 =item B<-e>, B<--execute>=C<perl-code>
311 Execute this code on startup and exit afterwards.
313 =item B<-f>, B<--file>=C<filename>
315 Execute the code from the file C<filename> on startup and exit
322 Users of Ruby on Rails will recognize this as a perl reimplementation of the
323 rails scripts/console. It's intend is to provide a shell environment to the
324 lx-office internals. This will mostly not interest you if you just want to do
325 your ERP stuff with lx-office, but will be invaluable for those who wish to
326 make changes to lx-office itself.
330 You can do most things in the console that you could do in an actual perl
331 script. Certain helper functions will aid you in debugging the state of the
336 Named after the rails pretty print gem, this will call Data::Dumper on the
337 given C<DATA>. Use it to see what is going on.
339 Currently C<pp> will set the Data::Dumper depth to 2, so if you need a
340 different depth, you'll have to change that. A nice feature would be to
341 configure that, or at least to be able to change it at runtime.
345 Returns a tabular representation of C<@data>. C<@data> must be an
346 array or array reference containing hash references. Column widths are
347 calculated automatically.
349 Undefined values are represented by an empty column.
353 ptab($dbh->selectall_arrayref("SELECT * FROM employee", { Slice => {} }));
357 Returns a textual representation of the L<Rose::DB> instance
358 C<$obj>. This includes the class name, then the primary key columns as
359 name/value pairs and then all other columns as name/value pairs.
361 Undefined values are represented by C<UNDEF>.
365 pobj(SL::DB::Manager::Employee->find_by(login => 'demo'));
367 =head2 sql C<[ $dbh, ] $query, @bind_values>
369 Executes an SQL query using the optional bind values. If the first
370 parameter is a database handle then that database handle is used;
371 otherwise the handle returned by L<SL::Form/get_standard_dbh> is used.
373 If the query is a C<SELECT> then the result is filtered through
374 L<ptab()>. Otherwise the result of C<$dbh->do($query, undef, @bind_values)>
379 sql(qq|SELECT * FROM employee|);
380 sql(SL::DB::Employee->new->db->dbh,
381 qq|UPDATE employee SET notes = ? WHERE login = ?|,
382 'This guy is evil!', 'demo');
384 =head2 lxinit C<login>
386 Login into lx-office using a specified login. No password will be required, and
387 security mechanisms will mostly be inactive. form, locale, myconfig will be
392 Attempts to reload modules that changed since last reload (or inital startup).
393 This will mostly work just fine, except for Moose classes that have been made
394 immutable. Keep in mind that existing objects will continue to have the methods
395 of the classes they were created with.
399 - Reload on immutable Moose classes is buggy.
400 - Logging in more than once is not supported by the program, and thus not by
401 the console. It seems to work, but strange things may happen.
405 Configuration of this script is located in:
407 config/kivitendo.conf
408 config/kivitendo.conf.default
410 See there for interesting options.
414 Sven Schöling <s.schoeling@linet-services.de>