X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=scripts%2Fconsole;h=bf4ffaa6c8fb05b16c2e47b77e6cbdb07c51377a;hb=2b9a68bb2041ebde41a7c52db436efc8dde06350;hp=32bebabf245c7217d2027655905a77390885f112;hpb=17a0869fc518978c148ff7d376039133de9bfe07;p=kivitendo-erp.git diff --git a/scripts/console b/scripts/console index 32bebabf2..bf4ffaa6c 100755 --- a/scripts/console +++ b/scripts/console @@ -2,11 +2,16 @@ use warnings; use strict; +use utf8; +use open qw(:std :utf8); use 5.008; # too much magic in here to include perl 5.6 BEGIN { - unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML). - push @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version. + use FindBin; + + unshift(@INC, $FindBin::Bin . '/../modules/override'); # Use our own versions of various modules (e.g. YAML). + push (@INC, $FindBin::Bin . '/..'); + push (@INC, $FindBin::Bin . '/../modules/fallback'); # Only use our own versions of modules if there's no system version. } use Data::Dumper; @@ -14,11 +19,11 @@ use Devel::REPL 1.002001; use File::Slurp; use Getopt::Long; use Pod::Usage; -use Term::ReadLine::Perl::Bind; # use sane key binding for rxvt users use SL::LxOfficeConf; SL::LxOfficeConf->read; +my $client = $::lx_office_conf{console}{client}; my $login = $::lx_office_conf{console}{login} || 'demo'; my $history_file = $::lx_office_conf{console}{history_file} || '/tmp/kivitendo_console_history.log'; # fallback if users is not writable my $debug_file = $::lx_office_conf{console}{log_file} || '/tmp/kivitendo_console_debug.log'; @@ -27,6 +32,7 @@ my ($execute_code, $execute_file, $help, $man); my $result = GetOptions( "login|l=s" => \$login, + "client|c=s" => \$client, "history-file|i=s" => \$history_file, "log-file|o=s" => \$debug_file, "execute|e=s" => \$execute_code, @@ -60,9 +66,13 @@ sub execute_code { my $repl = Devel::REPL->new; $repl->load_plugin($_) for @plugins; $repl->load_history($history_file); + +binmode($repl->out_fh, 'utf8'); + +$repl->eval('use utf8;'); $repl->eval('help'); -$repl->print("trying to auto login as '$login'..."); -$repl->print($repl->eval("lxinit '$login'")); +$repl->print("trying to auto login into client '$client' with login '$login'...\n"); +execute_code($repl, "lxinit '$client', '$login'"); my @code_to_execute = grep { $_ } ($autorun, $execute_code, $execute_file ? join('', read_file($execute_file)) : undef); execute_code($repl, $_) || exit 1 for @code_to_execute; @@ -83,15 +93,16 @@ use SL::Locale; use SL::LXDebug; use Data::Dumper; use List::Util qw(max); +use Time::HiRes; # this is a cleaned up version of am.pl # it lacks redirection, some html setup and most of the authentication process. # it is assumed that anyone with physical access and execution rights on this script # won't be hindered by authentication anyway. sub lxinit { - my $login = shift; + my ($client, $login) = @_; - die 'need login' unless $login; + die 'need client and login' unless $client && $login; package main; @@ -99,6 +110,8 @@ sub lxinit { $::locale = Locale->new($::lx_office_conf{system}->{language}); $::form = Form->new; $::auth = SL::Auth->new; + die "Cannot find client with ID or name '$client'" if !$::auth->set_client($client); + $::instance_conf = SL::InstanceConfiguration->new; $::request = SL::Request->new( cgi => CGI->new({}), @@ -113,9 +126,8 @@ sub lxinit { 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}); + $::myconfig{login} = $login; # so SL::DB::Manager::Employee->current works in test database $::instance_conf->init; @@ -150,11 +162,18 @@ sub help { Spezielle Kommandos: - help - zeigt diese Hilfe an. - 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 + help - zeigt diese Hilfe an. + 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. + clock { CODE } - zeigt die gebrauchte Zeit für die Ausführung von CODE an + quit - beendet die Konsole + + part - shortcuts auf die jeweilige SL::DB::{...}::find_by + customer, vendor, + order, invoice, + purchase_invoice, + chart EOL # load 'module' - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm. @@ -204,6 +223,48 @@ sub sql { } } +sub part { + require SL::DB::Part; + SL::DB::Manager::Part->find_by(@_) +} + +sub order { + require SL::DB::Order; + SL::DB::Manager::Order->find_by(@_) +} + +sub invoice { + require SL::DB::Invoice; + SL::DB::Manager::Invoice->find_by(@_) +} + +sub purchase_invoice { + require SL::DB::PurchaseInvoice; + SL::DB::Manager::PurchaseInvoice->find_by(@_) +} + +sub customer { + require SL::DB::Customer; + SL::DB::Manager::Customer->find_by(@_) +} + +sub vendor { + require SL::DB::Vendor; + SL::DB::Manager::Vendor->find_by(@_) +} + +sub chart { + require SL::DB::Chart; + SL::DB::Manager::Chart->find_by(@_) +} + +sub clock (&) { + my $s = [Time::HiRes::gettimeofday()]; + $_[0]->(); + Time::HiRes::tv_interval($s); +} + + 1; __END__ @@ -236,6 +297,12 @@ Print the manual page and exit. Log in as C. The default is to use the value from the configuration file and C if none is set there. +=item B<-c>, B<--client>=C + +Use the database for client C. C can be a client's +database ID or its name. The default is to use the value from the +configuration file. + =item B<-o>, B<--log-file>=C Use C as the log file. The default is to use the value from