scripts/console

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use 5.008;                          # too much magic in here to include perl 5.6
   6
   7 BEGIN {
   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.
  10 }
  11
  12 use Data::Dumper;
  13 use Devel::REPL 1.002001;
  14 use Term::ReadLine::Perl::Bind;     # use sane key binding for rxvt users
  15
  16 use SL::LxOfficeConf;
  17 SL::LxOfficeConf->read;
  18
  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};
  23
  24 # will be configed eventually
  25 my @plugins      = qw(History LexEnv Colors MultiLine::PPI FancyPrompt PermanentHistory AutoloadModules);
  26
  27 my $repl = Devel::REPL->new;
  28 $repl->load_plugin($_) for @plugins;
  29 $repl->load_history($history_file);
  30 $repl->eval('help');
  31 $repl->print("trying to auto login as '$login'...");
  32 $repl->print($repl->eval("lxinit '$login'"));
  33 if ($autorun) {
  34   my $result = $repl->eval($autorun);
  35   $repl->print($result->message) if ref($result) eq 'Devel::REPL::Error';
  36 }
  37 $repl->run;
  38
  39 package Devel::REPL;
  40
  41 use utf8;
  42 use CGI qw( -no_xhtml);
  43 use DateTime;
  44 use SL::Auth;
  45 use SL::Form;
  46 use SL::Helper::DateTime;
  47 use SL::Locale;
  48 use SL::LXDebug;
  49 use Data::Dumper;
  50
  51 # this is a cleaned up version of am.pl
  52 # it lacks redirection, some html setup and most of the authentication process.
  53 # it is assumed that anyone with physical access and execution rights on this script
  54 # won't be hindered by authentication anyway.
  55 sub lxinit {
  56   my $login = shift;
  57
  58   die 'need login' unless $login;
  59
  60   package main;
  61
  62   $::lxdebug = LXDebug->new(file => $debug_file);
  63   $::locale = Locale->new($::lx_office_conf{system}->{language});
  64   $::cgi    = CGI->new qw();
  65   $::form   = Form->new;
  66   $::auth   = SL::Auth->new;
  67
  68   die 'cannot reach auth db'               unless $::auth->session_tables_present;
  69
  70   $::auth->restore_session;
  71
  72   require "bin/mozilla/common.pl";
  73
  74   die "cannot find user $login"            unless %::myconfig = $::auth->read_user($login);
  75
  76   $::form->{login} = $login; # normaly implicit at login
  77
  78   die "cannot find locale for user $login" unless $::locale   = Locale->new($::myconfig{countrycode});
  79
  80
  81   return "logged in as $login";
  82 }
  83
  84 # these function provides a load command to slurp in a lx-office module
  85 # since it's seldomly useful, it's not documented in help
  86 sub load {
  87   my $module = shift;
  88   $module =~ s/[^\w]//g;
  89   require "bin/mozilla/$module.pl";
  90 }
  91
  92 sub reload {
  93   require Module::Reload;
  94   Module::Reload->check();
  95
  96   return "modules reloaded";
  97 }
  98
  99 sub quit {
 100   exit;
 101 }
 102
 103 sub help {
 104   print <<EOL;
 105
 106   Lx-Office Konsole
 107
 108   ./scripts/console [login]
 109
 110 Spezielle Kommandos:
 111
 112   help                - zeigt diese Hilfe an.
 113   lxinit 'login'      - lädt das Lx-Office Environment für den User 'login'.
 114   reload              - lädt modifizierte Module neu.
 115   pp DATA             - zeigt die Datenstruktur mit Data::Dumper an.
 116   quit                - beendet die Konsole
 117
 118 EOL
 119 #  load   'module'     - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm.
 120 }
 121
 122 sub pp {
 123   local $Data::Dumper::Indent   = 2;
 124   local $Data::Dumper::Maxdepth = 2;
 125   local $Data::Dumper::Sortkeys = 1;
 126   Data::Dumper::Dumper(@_);
 127 }
 128
 129 1;
 130
 131 __END__
 132
 133 =head1 NAME
 134
 135 scripts/console - Lx Office Console
 136
 137 =head1 SYNOPSIS
 138
 139   ./script/console
 140   > help               # displays a brief documentation
 141
 142 =head1 DESCRIPTION
 143
 144 Users of Ruby on Rails will recognize this as a perl reimplementation of the
 145 rails scripts/console. It's intend is to provide a shell environment to the
 146 lx-office internals. This will mostly not interest you if you just want to do
 147 your ERP stuff with lx-office, but will be invaluable for those who wish to
 148 make changes to lx-office itself.
 149
 150 =head1 FUNCTIONS
 151
 152 You can do most things in the console that you could do in an actual perl
 153 script. Certain helper functions will aid you in debugging the state of the
 154 program:
 155
 156 =head2 pp C<DATA>
 157
 158 Named after the rails pretty print gem, this will call Data::Dumper on the
 159 given C<DATA>. Use it to see what is going on.
 160
 161 Currently C<pp> will set the Data::Dumper depth to 2, so if you need a
 162 different depth, you'll have to change that. A nice feature would be to
 163 configure that, or at least to be able to change it at runtime.
 164
 165 =head2 lxinit C<login>
 166
 167 Login into lx-office using a specified login. No password will be required, and
 168 security mechanisms will mostly be inactive. form, locale, myconfig will be
 169 correctly set.
 170
 171 =head2 reload
 172
 173 Attempts to reload modules that changed since last reload (or inital startup).
 174 This will mostly work just fine, except for Moose classes that have been made
 175 immutable. Keep in mind that existing objects will continue to have the methods
 176 of the classes they were created with.
 177
 178 =head1 BUGS
 179
 180  - Reload on immutable Moose classes is buggy.
 181  - Logging in more than once is not supported by the program, and thus not by
 182    the console. It seems to work, but strange things may happen.
 183
 184 =head1 SEE ALSO
 185
 186 Configuration of this script is located in:
 187
 188  config/lx_office.conf
 189  config/lx_office.conf.default
 190
 191 See there for interesting options.
 192
 193 =head1 AUTHOR
 194
 195   Sven Schöling <s.schoeling@linet-services.de>
 196
 197 =cut