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);
88 # this is a cleaned up version of am.pl
89 # it lacks redirection, some html setup and most of the authentication process.
90 # it is assumed that anyone with physical access and execution rights on this script
91 # won't be hindered by authentication anyway.
93 my ($client, $login) = @_;
95 die 'need client and login' unless $client && $login;
99 $::lxdebug = LXDebug->new(file => $debug_file);
100 $::locale = Locale->new($::lx_office_conf{system}->{language});
102 $::auth = SL::Auth->new;
103 die "Cannot find client with ID or name '$client'" if !$::auth->set_client($client);
105 $::instance_conf = SL::InstanceConfiguration->new;
106 $::request = SL::Request->new(
108 layout => SL::Layout::None->new,
111 die 'cannot reach auth db' unless $::auth->session_tables_present;
113 $::auth->restore_session;
115 require "bin/mozilla/common.pl";
117 die "cannot find user $login" unless %::myconfig = $::auth->read_user(login => $login);
119 $::form->{login} = $login; # normaly implicit at login
121 die "cannot find locale for user $login" unless $::locale = Locale->new($::myconfig{countrycode});
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 quit - beendet die Konsole
162 part - shortcuts auf die jeweilige SL::DB::{...}::find_by
169 # load 'module' - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm.
173 local $Data::Dumper::Indent = 2;
174 local $Data::Dumper::Maxdepth = 2;
175 local $Data::Dumper::Sortkeys = 1;
176 Data::Dumper::Dumper(@_);
180 my @rows = ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
181 return '<empty result set>' unless @rows;
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;
189 return join("\n", @output);
194 return '<no object>' unless $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;
202 return "<${ref} " . join(' ', @columns) . '>';
206 my $dbh = ref($_[0]) ? shift : $::form->get_standard_dbh;
207 my ($query, @args) = @_;
209 if ($query =~ m/^\s*select/i) {
210 ptab($dbh->selectall_arrayref($query, { Slice => {} }, @args));
212 $dbh->do($query, { Slice => {} }, @args);
217 require SL::DB::Part;
218 SL::DB::Manager::Part->find_by(@_)
222 require SL::DB::Order;
223 SL::DB::Manager::Order->find_by(@_)
227 require SL::DB::Invoice;
228 SL::DB::Manager::Invoice->find_by(@_)
231 sub purchase_invoice {
232 require SL::DB::PurchaseInvoice;
233 SL::DB::Manager::PurchaseInvoice->find_by(@_)
237 require SL::DB::Customer;
238 SL::DB::Manager::Customer->find_by(@_)
242 require SL::DB::Vendor;
243 SL::DB::Manager::Vendor->find_by(@_)
247 require SL::DB::Chart;
248 SL::DB::Manager::Chart->find_by(@_)
257 scripts/console - kivitendo console
261 ./script/console [options]
262 > help # displays a brief documentation
266 The list of supported command line options includes:
270 =item B<--help>, B<-h>
272 Print this help message and exit.
276 Print the manual page and exit.
278 =item B<-l>, B<--login>=C<username>
280 Log in as C<username>. The default is to use the value from the
281 configuration file and C<demo> if none is set there.
283 =item B<-o>, B<--log-file>=C<filename>
285 Use C<filename> as the log file. The default is to use the value from
286 the configuration file and C</tmp/kivitendo_console_debug.log> if none
289 =item B<-i>, B<--history-file>=C<filename>
291 Use C<filename> as the history file for commands input by the
292 user. The default is to use the value from the configuration file and
293 C</tmp/kivitendo_console_history.log> if none is set there.
295 =item B<-e>, B<--execute>=C<perl-code>
297 Execute this code on startup and exit afterwards.
299 =item B<-f>, B<--file>=C<filename>
301 Execute the code from the file C<filename> on startup and exit
308 Users of Ruby on Rails will recognize this as a perl reimplementation of the
309 rails scripts/console. It's intend is to provide a shell environment to the
310 lx-office internals. This will mostly not interest you if you just want to do
311 your ERP stuff with lx-office, but will be invaluable for those who wish to
312 make changes to lx-office itself.
316 You can do most things in the console that you could do in an actual perl
317 script. Certain helper functions will aid you in debugging the state of the
322 Named after the rails pretty print gem, this will call Data::Dumper on the
323 given C<DATA>. Use it to see what is going on.
325 Currently C<pp> will set the Data::Dumper depth to 2, so if you need a
326 different depth, you'll have to change that. A nice feature would be to
327 configure that, or at least to be able to change it at runtime.
331 Returns a tabular representation of C<@data>. C<@data> must be an
332 array or array reference containing hash references. Column widths are
333 calculated automatically.
335 Undefined values are represented by an empty column.
339 ptab($dbh->selectall_arrayref("SELECT * FROM employee", { Slice => {} }));
343 Returns a textual representation of the L<Rose::DB> instance
344 C<$obj>. This includes the class name, then the primary key columns as
345 name/value pairs and then all other columns as name/value pairs.
347 Undefined values are represented by C<UNDEF>.
351 pobj(SL::DB::Manager::Employee->find_by(login => 'demo'));
353 =head2 sql C<[ $dbh, ] $query, @bind_values>
355 Executes an SQL query using the optional bind values. If the first
356 parameter is a database handle then that database handle is used;
357 otherwise the handle returned by L<SL::Form/get_standard_dbh> is used.
359 If the query is a C<SELECT> then the result is filtered through
360 L<ptab()>. Otherwise the result of C<$dbh->do($query, undef, @bind_values)>
365 sql(qq|SELECT * FROM employee|);
366 sql(SL::DB::Employee->new->db->dbh,
367 qq|UPDATE employee SET notes = ? WHERE login = ?|,
368 'This guy is evil!', 'demo');
370 =head2 lxinit C<login>
372 Login into lx-office using a specified login. No password will be required, and
373 security mechanisms will mostly be inactive. form, locale, myconfig will be
378 Attempts to reload modules that changed since last reload (or inital startup).
379 This will mostly work just fine, except for Moose classes that have been made
380 immutable. Keep in mind that existing objects will continue to have the methods
381 of the classes they were created with.
385 - Reload on immutable Moose classes is buggy.
386 - Logging in more than once is not supported by the program, and thus not by
387 the console. It seems to work, but strange things may happen.
391 Configuration of this script is located in:
393 config/kivitendo.conf
394 config/kivitendo.conf.default
396 See there for interesting options.
400 Sven Schöling <s.schoeling@linet-services.de>