X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=scripts%2Fconsole;h=d264a8941f05e16c3f83fd0b5702dc4b969eda98;hb=75603a224c1bc962d18e9398972fa3bf2ff77f87;hp=42c193ac116ce0c77702e3408b44b16501a797d7;hpb=cad439ef9ef417497e2970110b62ed467719c6c4;p=kivitendo-erp.git diff --git a/scripts/console b/scripts/console index 42c193ac1..d264a8941 100755 --- a/scripts/console +++ b/scripts/console @@ -9,16 +9,17 @@ BEGIN { push @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version. } -use Config::Std; use Data::Dumper; use Devel::REPL 1.002001; use Term::ReadLine::Perl::Bind; # use sane key binding for rxvt users -read_config 'config/console.conf' => my %config;# if -f 'config/console.conf'; +use SL::LxOfficeConf; +SL::LxOfficeConf->read; -my $login = shift || $config{Console}{login} || 'demo'; -my $history_file = $config{Console}{history_file} || '/tmp/lxoffice_console_history.log'; # fallback if users is not writable -my $autorun = $config{Console}{autorun}; +my $login = shift || $::lx_office_conf{console}{login} || 'demo'; +my $history_file = $::lx_office_conf{console}{history_file} || '/tmp/lxoffice_console_history.log'; # fallback if users is not writable +my $debug_file = $::lx_office_conf{console}{log_file} || '/tmp/lxoffice_console_debug.log'; +my $autorun = $::lx_office_conf{console}{autorun}; # will be configed eventually my @plugins = qw(History LexEnv Colors MultiLine::PPI FancyPrompt PermanentHistory AutoloadModules); @@ -43,9 +44,11 @@ use DateTime; use SL::Auth; use SL::Form; use SL::Helper::DateTime; +use SL::InstanceConfiguration; use SL::Locale; use SL::LXDebug; use Data::Dumper; +use List::Util qw(max); # this is a cleaned up version of am.pl # it lacks redirection, some html setup and most of the authentication process. @@ -58,20 +61,12 @@ sub lxinit { package main; - { no warnings 'once'; - $::userspath = "users"; - $::templates = "templates"; - $::sendmail = "| /usr/sbin/sendmail -t"; - } - - eval { require "config/lx-erp.conf"; }; - eval { require "config/lx-erp-local.conf"; } if -f "config/lx-erp-local.conf"; - - $::lxdebug = LXDebug->new; - $::locale = Locale->new($::language); - $::cgi = CGI->new qw(); - $::form = Form->new; - $::auth = SL::Auth->new; + $::lxdebug = LXDebug->new(file => $debug_file); + $::locale = Locale->new($::lx_office_conf{system}->{language}); + $::form = Form->new; + $::auth = SL::Auth->new; + $::instance_conf = SL::InstanceConfiguration->new; + $::request = { cgi => CGI->new({}) }; die 'cannot reach auth db' unless $::auth->session_tables_present; @@ -79,12 +74,13 @@ sub lxinit { require "bin/mozilla/common.pl"; - die "cannot find user $login" unless %::myconfig = $::auth->read_user($login); + die "cannot find user $login" unless %::myconfig = $::auth->read_user(login => $login); $::form->{login} = $login; # normaly implicit at login die "cannot find locale for user $login" unless $::locale = Locale->new($::myconfig{countrycode}); + $::instance_conf->init; return "logged in as $login"; } @@ -111,14 +107,14 @@ sub quit { sub help { print <' unless @rows; + + my @columns = sort keys %{ $rows[0] }; + my @widths = map { max @{ $_ } } map { my $column = $_; [ length($column), map { length("" . ($_->{$column} // '')) } @rows ] } @columns; + my @output = (join ' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $columns[$_] } (0..@columns - 1)); + push @output, join('-+-', map { '-' x $_ } @widths); + push @output, map { my $row = $_; join(' | ', map { my $width = $widths[$_]; sprintf "\%-${width}s", $row->{ $columns[$_] } // '' } (0..@columns - 1) ) } @rows; + + return join("\n", @output); +} + +sub pobj { + my ($obj) = @_; + return '' unless $obj; + + my $ref = ref $obj; + $ref =~ s/^SL::DB:://; + my %primaries = map { ($_ => 1) } $obj->meta->primary_key; + my @columns = map { "${_}:" . ($obj->$_ // 'UNDEF') } sort $obj->meta->primary_key; + push @columns, map { "${_}:" . ($obj->$_ // 'UNDEF') } grep { !$primaries{$_} } sort map { $_->{name} } $obj->meta->columns; + + return "<${ref} " . join(' ', @columns) . '>'; +} + +sub sql { + my $dbh = ref($_[0]) ? shift : $::form->get_standard_dbh; + my ($query, @args) = @_; + + if ($query =~ m/^\s*select/i) { + ptab($dbh->selectall_arrayref($query, { Slice => {} }, @args)); + } else { + $dbh->do($query, { Slice => {} }, @args); + } +} + 1; __END__ =head1 NAME -scripts/console - Lx Office Console +scripts/console - kivitendo console =head1 SYNOPSIS @@ -170,6 +203,47 @@ Currently C will set the Data::Dumper depth to 2, so if you need a different depth, you'll have to change that. A nice feature would be to configure that, or at least to be able to change it at runtime. +=head2 ptab C<@data> + +Returns a tabular representation of C<@data>. C<@data> must be an +array or array reference containing hash references. Column widths are +calculated automatically. + +Undefined values are represented by an empty column. + +Example usage: + + ptab($dbh->selectall_arrayref("SELECT * FROM employee", { Slice => {} })); + +=head2 pobj C<$obj> + +Returns a textual representation of the L instance +C<$obj>. This includes the class name, then the primary key columns as +name/value pairs and then all other columns as name/value pairs. + +Undefined values are represented by C. + +Example usage: + + pobj(SL::DB::Manager::Employee->find_by(login => 'demo')); + +=head2 sql C<[ $dbh, ] $query, @bind_values> + +Executes an SQL query using the optional bind values. If the first +parameter is a database handle then that database handle is used; +otherwise the handle returned by L is used. + +If the query is a C