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;
14 use Term::ReadLine::Perl::Bind; # use sane key binding for rxvt users
17 SL::LxOfficeConf->read;
19 my $login = shift || $::lx_office_conf{console}{login} || 'demo';
20 my $history_file = $::lx_office_conf{console}{history_file} || '/tmp/lxoffice_console_history.log'; # fallback if users is not writable
21 my $debug_file = $::lx_office_conf{console}{log_file} || '/tmp/lxoffice_console_debug.log';
22 my $autorun = $::lx_office_conf{console}{autorun};
24 # will be configed eventually
25 my @plugins = qw(History LexEnv Colors MultiLine::PPI FancyPrompt PermanentHistory AutoloadModules);
27 my $repl = Devel::REPL->new;
28 $repl->load_plugin($_) for @plugins;
29 $repl->load_history($history_file);
31 $repl->print("trying to auto login as '$login'...");
32 $repl->print($repl->eval("lxinit '$login'"));
34 my $result = $repl->eval($autorun);
35 $repl->print($result->message) if ref($result) eq 'Devel::REPL::Error';
42 use CGI qw( -no_xhtml);
46 use SL::Helper::DateTime;
47 use SL::InstanceConfiguration;
51 use List::Util qw(max);
53 # this is a cleaned up version of am.pl
54 # it lacks redirection, some html setup and most of the authentication process.
55 # it is assumed that anyone with physical access and execution rights on this script
56 # won't be hindered by authentication anyway.
60 die 'need login' unless $login;
64 $::lxdebug = LXDebug->new(file => $debug_file);
65 $::locale = Locale->new($::lx_office_conf{system}->{language});
67 $::auth = SL::Auth->new;
68 $::instance_conf = SL::InstanceConfiguration->new;
69 $::request = { cgi => CGI->new({}) };
71 die 'cannot reach auth db' unless $::auth->session_tables_present;
73 $::auth->restore_session;
75 require "bin/mozilla/common.pl";
77 die "cannot find user $login" unless %::myconfig = $::auth->read_user(login => $login);
79 $::form->{login} = $login; # normaly implicit at login
81 die "cannot find locale for user $login" unless $::locale = Locale->new($::myconfig{countrycode});
83 $::instance_conf->init;
85 return "logged in as $login";
88 # these function provides a load command to slurp in a lx-office module
89 # since it's seldomly useful, it's not documented in help
92 $module =~ s/[^\w]//g;
93 require "bin/mozilla/$module.pl";
97 require Module::Reload;
98 Module::Reload->check();
100 return "modules reloaded";
112 ./scripts/console [login]
116 help - zeigt diese Hilfe an.
117 lxinit 'login' - lädt das kivitendo-Environment für den User 'login'.
118 reload - lädt modifizierte Module neu.
119 pp DATA - zeigt die Datenstruktur mit Data::Dumper an.
120 quit - beendet die Konsole
123 # load 'module' - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm.
127 local $Data::Dumper::Indent = 2;
128 local $Data::Dumper::Maxdepth = 2;
129 local $Data::Dumper::Sortkeys = 1;
130 Data::Dumper::Dumper(@_);
134 my @rows = ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
135 return '<empty result set>' unless @rows;
137 my @columns = sort keys %{ $rows[0] };
138 my @widths = map { max @{ $_ } } map { my $column = $_; [ length($column), map { length("" . ($_->{$column} // '')) } @rows ] } @columns;
139 my @output = (join ' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $columns[$_] } (0..@columns - 1));
140 push @output, join('-+-', map { '-' x $_ } @widths);
141 push @output, map { my $row = $_; join(' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $row->{ $columns[$_] } // '' } (0..@columns - 1) ) } @rows;
143 return join("\n", @output);
148 return '<no object>' unless $obj;
151 $ref =~ s/^SL::DB:://;
152 my %primaries = map { ($_ => 1) } $obj->meta->primary_key;
153 my @columns = map { "${_}:" . ($obj->$_ // 'UNDEF') } sort $obj->meta->primary_key;
154 push @columns, map { "${_}:" . ($obj->$_ // 'UNDEF') } grep { !$primaries{$_} } sort map { $_->{name} } $obj->meta->columns;
156 return "<${ref} " . join(' ', @columns) . '>';
160 my $dbh = ref($_[0]) ? shift : $::form->get_standard_dbh;
161 my ($query, @args) = @_;
163 if ($query =~ m/^\s*select/i) {
164 ptab($dbh->selectall_arrayref($query, { Slice => {} }, @args));
166 $dbh->do($query, { Slice => {} }, @args);
176 scripts/console - kivitendo console
181 > help # displays a brief documentation
185 Users of Ruby on Rails will recognize this as a perl reimplementation of the
186 rails scripts/console. It's intend is to provide a shell environment to the
187 lx-office internals. This will mostly not interest you if you just want to do
188 your ERP stuff with lx-office, but will be invaluable for those who wish to
189 make changes to lx-office itself.
193 You can do most things in the console that you could do in an actual perl
194 script. Certain helper functions will aid you in debugging the state of the
199 Named after the rails pretty print gem, this will call Data::Dumper on the
200 given C<DATA>. Use it to see what is going on.
202 Currently C<pp> will set the Data::Dumper depth to 2, so if you need a
203 different depth, you'll have to change that. A nice feature would be to
204 configure that, or at least to be able to change it at runtime.
208 Returns a tabular representation of C<@data>. C<@data> must be an
209 array or array reference containing hash references. Column widths are
210 calculated automatically.
212 Undefined values are represented by an empty column.
216 ptab($dbh->selectall_arrayref("SELECT * FROM employee", { Slice => {} }));
220 Returns a textual representation of the L<Rose::DB> instance
221 C<$obj>. This includes the class name, then the primary key columns as
222 name/value pairs and then all other columns as name/value pairs.
224 Undefined values are represented by C<UNDEF>.
228 pobj(SL::DB::Manager::Employee->find_by(login => 'demo'));
230 =head2 sql C<[ $dbh, ] $query, @bind_values>
232 Executes an SQL query using the optional bind values. If the first
233 parameter is a database handle then that database handle is used;
234 otherwise the handle returned by L<SL::Form/get_standard_dbh> is used.
236 If the query is a C<SELECT> then the result is filtered through
237 L<ptab()>. Otherwise the result of C<$dbh->do($query, undef, @bind_values)>
242 sql(qq|SELECT * FROM employee|);
243 sql(SL::DB::Employee->new->db->dbh,
244 qq|UPDATE employee SET notes = ? WHERE login = ?|,
245 'This guy is evil!', 'demo');
247 =head2 lxinit C<login>
249 Login into lx-office using a specified login. No password will be required, and
250 security mechanisms will mostly be inactive. form, locale, myconfig will be
255 Attempts to reload modules that changed since last reload (or inital startup).
256 This will mostly work just fine, except for Moose classes that have been made
257 immutable. Keep in mind that existing objects will continue to have the methods
258 of the classes they were created with.
262 - Reload on immutable Moose classes is buggy.
263 - Logging in more than once is not supported by the program, and thus not by
264 the console. It seems to work, but strange things may happen.
268 Configuration of this script is located in:
270 config/kivitendo.conf
271 config/kivitendo.conf.default
273 See there for interesting options.
277 Sven Schöling <s.schoeling@linet-services.de>