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 = SL::Request->new(
71 layout => SL::Layout::None->new,
74 die 'cannot reach auth db' unless $::auth->session_tables_present;
76 $::auth->restore_session;
78 require "bin/mozilla/common.pl";
80 die "cannot find user $login" unless %::myconfig = $::auth->read_user(login => $login);
82 $::form->{login} = $login; # normaly implicit at login
84 die "cannot find locale for user $login" unless $::locale = Locale->new($::myconfig{countrycode});
86 $::instance_conf->init;
88 return "logged in as $login";
91 # these function provides a load command to slurp in a lx-office module
92 # since it's seldomly useful, it's not documented in help
95 $module =~ s/[^\w]//g;
96 require "bin/mozilla/$module.pl";
100 require Module::Reload;
101 Module::Reload->check();
103 return "modules reloaded";
115 ./scripts/console [login]
119 help - zeigt diese Hilfe an.
120 lxinit 'login' - lädt das kivitendo-Environment für den User 'login'.
121 reload - lädt modifizierte Module neu.
122 pp DATA - zeigt die Datenstruktur mit Data::Dumper an.
123 quit - beendet die Konsole
126 # load 'module' - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm.
130 local $Data::Dumper::Indent = 2;
131 local $Data::Dumper::Maxdepth = 2;
132 local $Data::Dumper::Sortkeys = 1;
133 Data::Dumper::Dumper(@_);
137 my @rows = ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
138 return '<empty result set>' unless @rows;
140 my @columns = sort keys %{ $rows[0] };
141 my @widths = map { max @{ $_ } } map { my $column = $_; [ length($column), map { length("" . ($_->{$column} // '')) } @rows ] } @columns;
142 my @output = (join ' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $columns[$_] } (0..@columns - 1));
143 push @output, join('-+-', map { '-' x $_ } @widths);
144 push @output, map { my $row = $_; join(' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $row->{ $columns[$_] } // '' } (0..@columns - 1) ) } @rows;
146 return join("\n", @output);
151 return '<no object>' unless $obj;
154 $ref =~ s/^SL::DB:://;
155 my %primaries = map { ($_ => 1) } $obj->meta->primary_key;
156 my @columns = map { "${_}:" . ($obj->$_ // 'UNDEF') } sort $obj->meta->primary_key;
157 push @columns, map { "${_}:" . ($obj->$_ // 'UNDEF') } grep { !$primaries{$_} } sort map { $_->{name} } $obj->meta->columns;
159 return "<${ref} " . join(' ', @columns) . '>';
163 my $dbh = ref($_[0]) ? shift : $::form->get_standard_dbh;
164 my ($query, @args) = @_;
166 if ($query =~ m/^\s*select/i) {
167 ptab($dbh->selectall_arrayref($query, { Slice => {} }, @args));
169 $dbh->do($query, { Slice => {} }, @args);
179 scripts/console - kivitendo console
184 > help # displays a brief documentation
188 Users of Ruby on Rails will recognize this as a perl reimplementation of the
189 rails scripts/console. It's intend is to provide a shell environment to the
190 lx-office internals. This will mostly not interest you if you just want to do
191 your ERP stuff with lx-office, but will be invaluable for those who wish to
192 make changes to lx-office itself.
196 You can do most things in the console that you could do in an actual perl
197 script. Certain helper functions will aid you in debugging the state of the
202 Named after the rails pretty print gem, this will call Data::Dumper on the
203 given C<DATA>. Use it to see what is going on.
205 Currently C<pp> will set the Data::Dumper depth to 2, so if you need a
206 different depth, you'll have to change that. A nice feature would be to
207 configure that, or at least to be able to change it at runtime.
211 Returns a tabular representation of C<@data>. C<@data> must be an
212 array or array reference containing hash references. Column widths are
213 calculated automatically.
215 Undefined values are represented by an empty column.
219 ptab($dbh->selectall_arrayref("SELECT * FROM employee", { Slice => {} }));
223 Returns a textual representation of the L<Rose::DB> instance
224 C<$obj>. This includes the class name, then the primary key columns as
225 name/value pairs and then all other columns as name/value pairs.
227 Undefined values are represented by C<UNDEF>.
231 pobj(SL::DB::Manager::Employee->find_by(login => 'demo'));
233 =head2 sql C<[ $dbh, ] $query, @bind_values>
235 Executes an SQL query using the optional bind values. If the first
236 parameter is a database handle then that database handle is used;
237 otherwise the handle returned by L<SL::Form/get_standard_dbh> is used.
239 If the query is a C<SELECT> then the result is filtered through
240 L<ptab()>. Otherwise the result of C<$dbh->do($query, undef, @bind_values)>
245 sql(qq|SELECT * FROM employee|);
246 sql(SL::DB::Employee->new->db->dbh,
247 qq|UPDATE employee SET notes = ? WHERE login = ?|,
248 'This guy is evil!', 'demo');
250 =head2 lxinit C<login>
252 Login into lx-office using a specified login. No password will be required, and
253 security mechanisms will mostly be inactive. form, locale, myconfig will be
258 Attempts to reload modules that changed since last reload (or inital startup).
259 This will mostly work just fine, except for Moose classes that have been made
260 immutable. Keep in mind that existing objects will continue to have the methods
261 of the classes they were created with.
265 - Reload on immutable Moose classes is buggy.
266 - Logging in more than once is not supported by the program, and thus not by
267 the console. It seems to work, but strange things may happen.
271 Configuration of this script is located in:
273 config/kivitendo.conf
274 config/kivitendo.conf.default
276 See there for interesting options.
280 Sven Schöling <s.schoeling@linet-services.de>