Rose-Model Wiederkehrende Rechnungen: Foreign Key "order" nennen, nicht "oe"
[kivitendo-erp.git] / scripts / console
index added9f..d264a89 100755 (executable)
@@ -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/lx_office.conf' => my %config;
+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);
@@ -41,12 +42,13 @@ use utf8;
 use CGI qw( -no_xhtml);
 use DateTime;
 use SL::Auth;
-use SL::Dispatcher;
 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.
@@ -59,23 +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;
-
-  read_config 'config/lx_office.conf' => %::lx_office_conf;
-  SL::Dispatcher::_decode_recursively(\%::lx_office_conf);
+  $::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;
 
@@ -83,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";
 }
@@ -115,14 +107,14 @@ sub quit {
 sub help {
   print <<EOL;
 
-  Lx-Office Konsole
+  kivitendo Konsole
 
   ./scripts/console [login]
 
 Spezielle Kommandos:
 
   help                - zeigt diese Hilfe an.
-  lxinit 'login'      - lädt das Lx-Office Environment für den User 'login'.
+  lxinit 'login'      - lädt das kivitendo-Environment für den User 'login'.
   reload              - lädt modifizierte Module neu.
   pp DATA             - zeigt die Datenstruktur mit Data::Dumper an.
   quit                - beendet die Konsole
@@ -138,13 +130,50 @@ sub pp {
   Data::Dumper::Dumper(@_);
 }
 
+sub ptab {
+  my @rows = ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
+  return '<empty result set>' 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 '<no object>' 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
 
@@ -174,6 +203,47 @@ Currently C<pp> 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<Rose::DB> 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<UNDEF>.
+
+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<SL::Form/get_standard_dbh> is used.
+
+If the query is a C<SELECT> then the result is filtered through
+L<ptab()>. Otherwise the result of C<$dbh-&gt;do($query, undef, @bind_values)>
+is returned.
+
+Example usage:
+
+    sql(qq|SELECT * FROM employee|);
+    sql(SL::DB::Employee->new->db->dbh,
+        qq|UPDATE employee SET notes = ? WHERE login = ?|,
+        'This guy is evil!', 'demo');
+
 =head2 lxinit C<login>
 
 Login into lx-office using a specified login. No password will be required, and
@@ -197,8 +267,8 @@ of the classes they were created with.
 
 Configuration of this script is located in:
 
- config/lx_office.conf
- config/lx_office.conf.default
+ config/kivitendo.conf
+ config/kivitendo.conf.default
 
 See there for interesting options.