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;
use Devel::REPL 1.002001;
-use Term::ReadLine::Perl::Bind; # use sane key binding for rxvt users
+use File::Slurp;
+use Getopt::Long;
+use Pod::Usage;
use SL::LxOfficeConf;
SL::LxOfficeConf->read;
-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 $autorun = $::lx_office_conf{console}{autorun};
+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';
+my $autorun = $::lx_office_conf{console}{autorun};
+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,
+ "file|f=s" => \$execute_file,
+ "help|h" => \$help,
+ "man" => \$man,
+);
+pod2usage(2) if !$result;
+pod2usage(1) if $help;
+pod2usage(-exitstatus => 0, -verbose => 2) if $man;
# will be configed eventually
my @plugins = qw(History LexEnv Colors MultiLine::PPI FancyPrompt PermanentHistory AutoloadModules);
+sub execute_code {
+ my ($repl, $code) = @_;
+
+ my $result = $repl->eval($code);
+ if (ref($result) eq 'Devel::REPL::Error') {
+ $repl->print($result->message);
+ return 0;
+ }
+ if ($@) {
+ $repl->print($@);
+ return 0;
+ }
+
+ return 1;
+}
+
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'"));
-if ($autorun) {
- my $result = $repl->eval($autorun);
- $repl->print($result->message) if ref($result) eq 'Devel::REPL::Error';
-}
+$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;
+exit if $execute_code || $execute_file;
+
$repl->run;
package Devel::REPL;
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);
+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;
- $::lxdebug = LXDebug->new;
- $::locale = Locale->new($::lx_office_conf{system}->{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;
+ 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({}),
+ layout => SL::Layout::None->new,
+ );
die 'cannot reach auth db' unless $::auth->session_tables_present;
require "bin/mozilla/common.pl";
- die "cannot find user $login" unless %::myconfig = $::auth->read_user($login);
-
- $::form->{login} = $login; # normaly implicit at login
+ die "cannot find user $login" unless %::myconfig = $::auth->read_user(login => $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;
return "logged in as $login";
}
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'.
- 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.
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);
+ }
+}
+
+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__
=head1 NAME
-scripts/console - Lx Office Console
+scripts/console - kivitendo console
=head1 SYNOPSIS
- ./script/console
+ ./script/console [options]
> help # displays a brief documentation
+=head1 OPTIONS
+
+The list of supported command line options includes:
+
+=over 8
+
+=item B<--help>, B<-h>
+
+Print this help message and exit.
+
+=item B<--man>
+
+Print the manual page and exit.
+
+=item B<-l>, B<--login>=C<username>
+
+Log in as C<username>. The default is to use the value from the
+configuration file and C<demo> if none is set there.
+
+=item B<-c>, B<--client>=C<client>
+
+Use the database for client C<client>. C<client> 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<filename>
+
+Use C<filename> as the log file. The default is to use the value from
+the configuration file and C</tmp/kivitendo_console_debug.log> if none
+is set there.
+
+=item B<-i>, B<--history-file>=C<filename>
+
+Use C<filename> as the history file for commands input by the
+user. The default is to use the value from the configuration file and
+C</tmp/kivitendo_console_history.log> if none is set there.
+
+=item B<-e>, B<--execute>=C<perl-code>
+
+Execute this code on startup and exit afterwards.
+
+=item B<-f>, B<--file>=C<filename>
+
+Execute the code from the file C<filename> on startup and exit
+afterwards.
+
+=back
+
=head1 DESCRIPTION
Users of Ruby on Rails will recognize this as a perl reimplementation of the
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->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
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.
projects / kivitendo-erp.git / blobdiff