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;
17 use Term::ReadLine::Perl::Bind; # use sane key binding for rxvt users
20 SL::LxOfficeConf->read;
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 "history-file|i=s" => \$history_file,
31 "log-file|o=s" => \$debug_file,
32 "execute|e=s" => \$execute_code,
33 "file|f=s" => \$execute_file,
37 pod2usage(2) if !$result;
38 pod2usage(1) if $help;
39 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
41 # will be configed eventually
42 my @plugins = qw(History LexEnv Colors MultiLine::PPI FancyPrompt PermanentHistory AutoloadModules);
45 my ($repl, $code) = @_;
47 my $result = $repl->eval($code);
48 if (ref($result) eq 'Devel::REPL::Error') {
49 $repl->print($result->message);
60 my $repl = Devel::REPL->new;
61 $repl->load_plugin($_) for @plugins;
62 $repl->load_history($history_file);
64 $repl->print("trying to auto login as '$login'...");
65 $repl->print($repl->eval("lxinit '$login'"));
67 my @code_to_execute = grep { $_ } ($autorun, $execute_code, $execute_file ? join('', read_file($execute_file)) : undef);
68 execute_code($repl, $_) || exit 1 for @code_to_execute;
69 exit if $execute_code || $execute_file;
76 use CGI qw( -no_xhtml);
80 use SL::Helper::DateTime;
81 use SL::InstanceConfiguration;
85 use List::Util qw(max);
87 # this is a cleaned up version of am.pl
88 # it lacks redirection, some html setup and most of the authentication process.
89 # it is assumed that anyone with physical access and execution rights on this script
90 # won't be hindered by authentication anyway.
94 die 'need login' unless $login;
98 $::lxdebug = LXDebug->new(file => $debug_file);
99 $::locale = Locale->new($::lx_office_conf{system}->{language});
101 $::auth = SL::Auth->new;
102 $::instance_conf = SL::InstanceConfiguration->new;
103 $::request = SL::Request->new(
105 layout => SL::Layout::None->new,
108 die 'cannot reach auth db' unless $::auth->session_tables_present;
110 $::auth->restore_session;
112 require "bin/mozilla/common.pl";
114 die "cannot find user $login" unless %::myconfig = $::auth->read_user(login => $login);
116 $::form->{login} = $login; # normaly implicit at login
118 die "cannot find locale for user $login" unless $::locale = Locale->new($::myconfig{countrycode});
120 $::instance_conf->init;
122 return "logged in as $login";
125 # these function provides a load command to slurp in a lx-office module
126 # since it's seldomly useful, it's not documented in help
129 $module =~ s/[^\w]//g;
130 require "bin/mozilla/$module.pl";
134 require Module::Reload;
135 Module::Reload->check();
137 return "modules reloaded";
149 ./scripts/console [login]
153 help - zeigt diese Hilfe an.
154 lxinit 'login' - lädt das kivitendo-Environment für den User 'login'.
155 reload - lädt modifizierte Module neu.
156 pp DATA - zeigt die Datenstruktur mit Data::Dumper an.
157 quit - beendet die Konsole
160 # load 'module' - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm.
164 local $Data::Dumper::Indent = 2;
165 local $Data::Dumper::Maxdepth = 2;
166 local $Data::Dumper::Sortkeys = 1;
167 Data::Dumper::Dumper(@_);
171 my @rows = ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
172 return '<empty result set>' unless @rows;
174 my @columns = sort keys %{ $rows[0] };
175 my @widths = map { max @{ $_ } } map { my $column = $_; [ length($column), map { length("" . ($_->{$column} // '')) } @rows ] } @columns;
176 my @output = (join ' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $columns[$_] } (0..@columns - 1));
177 push @output, join('-+-', map { '-' x $_ } @widths);
178 push @output, map { my $row = $_; join(' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $row->{ $columns[$_] } // '' } (0..@columns - 1) ) } @rows;
180 return join("\n", @output);
185 return '<no object>' unless $obj;
188 $ref =~ s/^SL::DB:://;
189 my %primaries = map { ($_ => 1) } $obj->meta->primary_key;
190 my @columns = map { "${_}:" . ($obj->$_ // 'UNDEF') } sort $obj->meta->primary_key;
191 push @columns, map { "${_}:" . ($obj->$_ // 'UNDEF') } grep { !$primaries{$_} } sort map { $_->{name} } $obj->meta->columns;
193 return "<${ref} " . join(' ', @columns) . '>';
197 my $dbh = ref($_[0]) ? shift : $::form->get_standard_dbh;
198 my ($query, @args) = @_;
200 if ($query =~ m/^\s*select/i) {
201 ptab($dbh->selectall_arrayref($query, { Slice => {} }, @args));
203 $dbh->do($query, { Slice => {} }, @args);
213 scripts/console - kivitendo console
217 ./script/console [options]
218 > help # displays a brief documentation
222 The list of supported command line options includes:
226 =item B<--help>, B<-h>
228 Print this help message and exit.
232 Print the manual page and exit.
234 =item B<-l>, B<--login>=C<username>
236 Log in as C<username>. The default is to use the value from the
237 configuration file and C<demo> if none is set there.
239 =item B<-o>, B<--log-file>=C<filename>
241 Use C<filename> as the log file. The default is to use the value from
242 the configuration file and C</tmp/kivitendo_console_debug.log> if none
245 =item B<-i>, B<--history-file>=C<filename>
247 Use C<filename> as the history file for commands input by the
248 user. The default is to use the value from the configuration file and
249 C</tmp/kivitendo_console_history.log> if none is set there.
251 =item B<-e>, B<--execute>=C<perl-code>
253 Execute this code on startup and exit afterwards.
255 =item B<-f>, B<--file>=C<filename>
257 Execute the code from the file C<filename> on startup and exit
264 Users of Ruby on Rails will recognize this as a perl reimplementation of the
265 rails scripts/console. It's intend is to provide a shell environment to the
266 lx-office internals. This will mostly not interest you if you just want to do
267 your ERP stuff with lx-office, but will be invaluable for those who wish to
268 make changes to lx-office itself.
272 You can do most things in the console that you could do in an actual perl
273 script. Certain helper functions will aid you in debugging the state of the
278 Named after the rails pretty print gem, this will call Data::Dumper on the
279 given C<DATA>. Use it to see what is going on.
281 Currently C<pp> will set the Data::Dumper depth to 2, so if you need a
282 different depth, you'll have to change that. A nice feature would be to
283 configure that, or at least to be able to change it at runtime.
287 Returns a tabular representation of C<@data>. C<@data> must be an
288 array or array reference containing hash references. Column widths are
289 calculated automatically.
291 Undefined values are represented by an empty column.
295 ptab($dbh->selectall_arrayref("SELECT * FROM employee", { Slice => {} }));
299 Returns a textual representation of the L<Rose::DB> instance
300 C<$obj>. This includes the class name, then the primary key columns as
301 name/value pairs and then all other columns as name/value pairs.
303 Undefined values are represented by C<UNDEF>.
307 pobj(SL::DB::Manager::Employee->find_by(login => 'demo'));
309 =head2 sql C<[ $dbh, ] $query, @bind_values>
311 Executes an SQL query using the optional bind values. If the first
312 parameter is a database handle then that database handle is used;
313 otherwise the handle returned by L<SL::Form/get_standard_dbh> is used.
315 If the query is a C<SELECT> then the result is filtered through
316 L<ptab()>. Otherwise the result of C<$dbh->do($query, undef, @bind_values)>
321 sql(qq|SELECT * FROM employee|);
322 sql(SL::DB::Employee->new->db->dbh,
323 qq|UPDATE employee SET notes = ? WHERE login = ?|,
324 'This guy is evil!', 'demo');
326 =head2 lxinit C<login>
328 Login into lx-office using a specified login. No password will be required, and
329 security mechanisms will mostly be inactive. form, locale, myconfig will be
334 Attempts to reload modules that changed since last reload (or inital startup).
335 This will mostly work just fine, except for Moose classes that have been made
336 immutable. Keep in mind that existing objects will continue to have the methods
337 of the classes they were created with.
341 - Reload on immutable Moose classes is buggy.
342 - Logging in more than once is not supported by the program, and thus not by
343 the console. It seems to work, but strange things may happen.
347 Configuration of this script is located in:
349 config/kivitendo.conf
350 config/kivitendo.conf.default
352 See there for interesting options.
356 Sven Schöling <s.schoeling@linet-services.de>