Nur ein globales Locale-Objekt anlegen
authorSven Schöling <s.schoeling@linet-services.de>
Tue, 20 Jul 2010 08:27:17 +0000 (10:27 +0200)
committerSven Schöling <s.schoeling@linet-services.de>
Tue, 20 Jul 2010 08:27:17 +0000 (10:27 +0200)
Außerdem alle lokalen Locale-Objekte entfernt. Ist so noch nicht funktionabel.

Conflicts:

SL/Template/Plugin/T8.pm
scripts/console
scripts/rose_auto_create_model.pl
scripts/sync_with_sugarcrm.pl

12 files changed:
SL/Dispatcher.pm
SL/Template/Plugin/LxERP.pm
SL/Template/Plugin/T8.pm
SL/User.pm
bin/mozilla/login.pl
bin/mozilla/menuXML.pl
bin/mozilla/menujs.pl
bin/mozilla/menunew.pl
bin/mozilla/menuv3.pl
bin/mozilla/menuv4.pl
scripts/console [new file with mode: 0755]
scripts/dbupgrade2_tool.pl

index 0e19954..6dc741f 100644 (file)
@@ -34,7 +34,7 @@ sub show_error {
   my $template             = shift;
   my $error_type           = shift || '';
 
-  $::locale                = Locale->new($::language, 'all');
+  $::locale                = Locale->new($::language);
   $::form->{error}         = $::locale->text('The session is invalid or has expired.') if ($error_type eq 'session');
   $::form->{error}         = $::locale->text('Incorrect password!.')                   if ($error_type eq 'password');
   $::myconfig{countrycode} = $::language;
@@ -128,7 +128,7 @@ sub handle_request {
   require_main_code($script, $suffix);
 
   $::cgi            = CGI->new('');
-  $::locale         = Locale->new($::language, $script);
+  $::locale         = Locale->new($::language);
   $::form           = Form->new;
   $::form->{script} = $script . $suffix;
 
@@ -150,7 +150,7 @@ sub handle_request {
 
       show_error('login/password_error', 'password') unless $::myconfig{login};
 
-      $::locale = Locale->new($::myconfig{countrycode}, $script);
+      $::locale = Locale->new($::myconfig{countrycode});
 
       show_error('login/password_error', 'password') if SL::Auth::OK != $::auth->authenticate($::form->{login}, $::form->{password}, 0);
 
index b36fceb..40bf195 100644 (file)
@@ -110,8 +110,7 @@ sub abs {
 
 sub t8 {
   my ($self, $text, @args) = @_;
-  $self->{locale} ||= Locale->new($::myconfig{countrycode}, 'all');
-  return $self->{locale}->text($text, @args) || $text;
+  return $::locale->text($text, @args) || $text;
 }
 
 1;
index e736e0c..2208ff4 100644 (file)
@@ -3,13 +3,9 @@ package SL::Template::Plugin::T8;
 use Template::Plugin::Filter;
 use base qw( Template::Plugin::Filter );
 
-my $locale = undef;
-
 sub init {
   my $self = shift;
 
-  $locale ||= Locale->new($main::myconfig{countrycode}, 'all');
-
   # first arg can specify filter name
   $self->install_filter($self->{ _ARGS }->[0] || 'T8');
 
@@ -18,7 +14,7 @@ sub init {
 
 sub filter {
   my ($self, $text, $args) = @_;
-  return $locale->text($text, @{ $args || [] }) || $text;
+  return $::locale->text($text, @{ $args || [] }) || $text;
 }
 
 return 'SL::Template::Plugin::T8';
index 88ea5b3..46fe855 100644 (file)
@@ -450,10 +450,7 @@ sub process_perl_script {
   map({ $dbup_myconfig{$_} = $form->{$_}; }
       qw(dbname dbuser dbpasswd dbhost dbport dbconnect));
 
-  my $nls_file = $filename;
-  $nls_file =~ s|.*/||;
-  $nls_file =~ s|.pl$||;
-  my $dbup_locale = Locale->new($main::language, $nls_file);
+  my $dbup_locale = $::locale;
 
   my $result = eval($contents);
 
index 622db69..b04adc2 100644 (file)
@@ -39,7 +39,6 @@ use strict;
 
 our $cgi;
 our $form;
-our $locale;
 our $auth;
 
 sub run {
@@ -48,14 +47,13 @@ sub run {
 
   $cgi    = $::cgi;
   $form   = $::form;
-  $locale = $::locale;
   $auth   = $::auth;
 
   $form->{stylesheet} = "lx-office-erp.css";
   $form->{favicon}    = "favicon.ico";
 
   if (SL::Auth::SESSION_EXPIRED == $session_result) {
-    $form->{error_message} = $locale->text('The session is invalid or has expired.');
+    $form->{error_message} = $::locale->text('The session is invalid or has expired.');
     login_screen();
     ::end_of_request();
   }
@@ -67,14 +65,14 @@ sub run {
     our %myconfig = $auth->read_user($form->{login}) if ($form->{login});
 
     if (!$myconfig{login} || (SL::Auth::OK != $auth->authenticate($form->{login}, $form->{password}, 0))) {
-      $form->{error_message} = $locale->text('Incorrect Password!');
+      $form->{error_message} = $::locale->text('Incorrect Password!');
       login_screen();
     } else {
       $auth->set_session_value('login', $form->{login}, 'password', $form->{password});
       $auth->create_or_refresh_session();
 
       $form->{titlebar} .= " - $myconfig{name} - $myconfig{dbname}";
-      call_sub($locale->findsub($action));
+      call_sub($::locale->findsub($action));
     }
   } else {
     login_screen();
@@ -103,7 +101,7 @@ sub login {
   $main::lxdebug->enter_sub();
 
   unless ($form->{login}) {
-    login_screen($locale->text('You did not enter a name!'));
+    login_screen($::locale->text('You did not enter a name!'));
     ::end_of_request();
   }
 
@@ -113,7 +111,7 @@ sub login {
   my $result;
   if (($result = $user->login($form)) <= -1) {
     ::end_of_request() if $result == -2;
-    login_screen($locale->text('Incorrect username or password!'));
+    login_screen($::locale->text('Incorrect username or password!'));
     ::end_of_request();
   }
 
@@ -151,7 +149,7 @@ sub logout {
 
   # remove the callback to display the message
   $form->{callback} = "login.pl?action=";
-  $form->redirect($locale->text('You are logged out!'));
+  $form->redirect($::locale->text('You are logged out!'));
 
   $main::lxdebug->leave_sub();
 }
@@ -160,12 +158,10 @@ sub company_logo {
   $main::lxdebug->enter_sub();
 
   my %myconfig = %main::myconfig;
-  $locale             =  new Locale $myconfig{countrycode}, "login" if ($main::language ne $myconfig{countrycode});
-
   $form->{todo_list}  =  create_todo_list('login_screen' => 1) if (!$form->{no_todo_list});
 
   $form->{stylesheet} =  $myconfig{stylesheet};
-  $form->{title}      =  $locale->text('About');
+  $form->{title}      =  $::locale->text('About');
 
   # create the logo screen
   $form->header() unless $form->{noheader};
@@ -177,8 +173,7 @@ sub company_logo {
 
 sub show_error {
   my $template           = shift;
-  my %myconfig = %main::myconfig;
-  $locale                = Locale->new($main::language, 'all');
+  my %myconfig           = %main::myconfig;
   $myconfig{countrycode} = $main::language;
   $form->{stylesheet}    = 'css/lx-office-erp.css';
 
index 5744c84..b79d605 100644 (file)
@@ -45,8 +45,6 @@ use URI;
 
 use strict;
 
-my $locale;
-
 1;
 
 # end of main
@@ -55,7 +53,6 @@ sub display {
   my $form     = $main::form;
   my %myconfig = %main::myconfig;
 
-  $locale     = Locale->new($myconfig{countrycode}, "menu");
   my $charset = $main::dbcharset || 'ISO-8859-1';
   my $callback            = $form->unescape($form->{callback});
   $callback               = URI->new($callback)->rel($callback) if $callback;
@@ -66,10 +63,10 @@ sub display {
     . qq|<?xml version="1.0" encoding="${charset}"?>
 <?xml-stylesheet href="xslt/xulmenu.xsl" type="text/xsl"?>
 <!DOCTYPE doc [
-<!ENTITY szlig "| . $locale->{iconv_iso8859}->convert('ß') . qq|">
-<!ENTITY auml "| . $locale->{iconv_iso8859}->convert('ä') . qq|">
-<!ENTITY ouml "| . $locale->{iconv_iso8859}->convert('ö') . qq|">
-<!ENTITY uuml "| . $locale->{iconv_iso8859}->convert('ü') . qq|">
+<!ENTITY szlig "| . $::locale->{iconv_iso8859}->convert('ß') . qq|">
+<!ENTITY auml "| . $::locale->{iconv_iso8859}->convert('ä') . qq|">
+<!ENTITY ouml "| . $::locale->{iconv_iso8859}->convert('ö') . qq|">
+<!ENTITY uuml "| . $::locale->{iconv_iso8859}->convert('ü') . qq|">
 ]>
 
 <doc>
@@ -129,7 +126,7 @@ sub print_menu {
     next if (($item eq "") || ($item =~ /--/));
 
     my $menu_item = $menu->{"${parent}${item}"};
-    my $menu_title = $locale->text($item);
+    my $menu_title = $::locale->text($item);
     my $menu_text = $menu_title;
 
     my $target = "main_window";
index ef7b2b8..af60595 100644 (file)
@@ -41,8 +41,6 @@ use CGI::Carp qw(fatalsToBrowser);
 
 use strict;
 
-my $locale;
-
 1;
 
 # end of main
@@ -82,7 +80,7 @@ sub clock_line {
   my $login = "[Nutzer "
     . $form->{login}
     . " - <a href=\"login.pl?action=logout\" target=\"_top\">"
-    . $locale->text('Logout')
+    . $::locale->text('Logout')
     . "</a>] ";
   my ($Sekunden, $Minuten,   $Stunden,   $Monatstag, $Monat,
       $Jahr,     $Wochentag, $Jahrestag, $Sommerzeit)
@@ -136,7 +134,6 @@ sub acc_menu {
   my $form     = $main::form;
   my %myconfig = %main::myconfig;
 
-  $locale = Locale->new($myconfig{countrycode}, "menu");
   my $mainlevel = $form->{level};
   $mainlevel =~ s/$mainlevel--//g;
   my $menu = new Menu "$menufile";
@@ -390,7 +387,7 @@ sub section_menu {
     my $ml    = $item;
     $label =~ s/$level--//g;
     $ml    =~ s/--.*//;
-    $label = $locale->text($label);
+    $label = $::locale->text($label);
     $label =~ s/ /&nbsp;/g;
     $menu->{$item}{target} = "main_window" unless $menu->{$item}{target};
 
index 793cec2..6b4f971 100644 (file)
@@ -40,8 +40,6 @@ use SL::Menu;
 
 use strict;
 
-my $locale;
-
 1;
 
 # end of main
@@ -91,7 +89,6 @@ sub clock_line {
 sub acc_menu {
   my $form     = $main::form;
   my %myconfig = %main::myconfig;
-  $locale = Locale->new($myconfig{countrycode}, "menu");
 
   my $mainlevel =  $form->{level};
   $mainlevel    =~ s/\Q$mainlevel\E--//g;
@@ -135,7 +132,7 @@ sub create_menu {
     next if (($name eq "") || ($name =~ /--/));
 
     my $menu_item = $menu->{"${parent}${name}"};
-    my $item      = { 'title' => $locale->text($name) };
+    my $item      = { 'title' => $::locale->text($name) };
     push @{ $all_items }, $item;
 
     if ($menu_item->{submenu} || !defined($menu_item->{module}) || ($menu_item->{module} eq "menu.pl")) {
index 683cabf..49adcef 100644 (file)
@@ -38,7 +38,6 @@ use URI;
 use strict;
 
 my $menufile = "menu.ini";
-my $locale;
 
 1;
 
@@ -86,8 +85,6 @@ sub acc_menu {
   my $form     = $main::form;
   my %myconfig = %main::myconfig;
 
-  $locale = Locale->new($myconfig{countrycode}, "menu");
-
   my $mainlevel = $form->{level};
   $mainlevel =~ s/\Q$mainlevel\E--//g;
   my $menu = new Menu "$menufile";
@@ -118,7 +115,7 @@ sub print_menu {
     next if (($item eq "") || ($item =~ /--/));
 
     my $menu_item = $menu->{"${parent}${item}"};
-    my $menu_title = $locale->text($item);
+    my $menu_title = $::locale->text($item);
     my $menu_text = $menu_title;
 
     my $target = "main_window";
index 3b736bf..5459f6e 100644 (file)
@@ -38,7 +38,6 @@ use URI;
 use strict;
 
 my $menufile = "menu.ini";
-my $locale;
 
 1;
 
@@ -88,8 +87,6 @@ sub acc_menu {
   my $form     = $main::form;
   my %myconfig = %main::myconfig;
 
-  $locale = Locale->new($myconfig{countrycode}, "menu");
-
   my $mainlevel = $form->{level};
   $mainlevel =~ s/\Q$mainlevel\E--//g;
   my $menu = new Menu "$menufile";
@@ -120,7 +117,7 @@ sub print_menu {
     next if (($item eq "") || ($item =~ /--/));
 
     my $menu_item = $menu->{"${parent}${item}"};
-    my $menu_title = $locale->text($item);
+    my $menu_title = $::locale->text($item);
     my $menu_text = $menu_title;
 
     my $target = "main_window";
diff --git a/scripts/console b/scripts/console
new file mode 100755 (executable)
index 0000000..d7679d0
--- /dev/null
@@ -0,0 +1,196 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+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 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';
+
+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};
+
+# will be configed eventually
+my @plugins      = qw(History LexEnv Colors MultiLine::PPI FancyPrompt PermanentHistory AutoloadModules);
+
+my $repl = Devel::REPL->new;
+$repl->load_plugin($_) for @plugins;
+$repl->load_history($history_file);
+$repl->eval('help');
+$repl->print("trying to auto login as '$login'...");
+$repl->print($repl->eval("lxinit '$login'"));
+$repl->print($repl->eval($autorun)) if $autorun;
+$repl->run;
+
+package Devel::REPL;
+
+
+# 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;
+
+  die 'need login' unless $login;
+
+  package main;
+
+  { no warnings 'once';
+    $::userspath  = "users";
+    $::templates  = "templates";
+    $::memberfile = "users/members";
+    $::sendmail   = "| /usr/sbin/sendmail -t";
+  }
+
+  use SL::LXDebug;
+  $::lxdebug = LXDebug->new;
+
+  use CGI qw( -no_xhtml);
+  use SL::Auth;
+  use SL::Form;
+  use SL::Locale;
+  use Data::Dumper;
+
+  eval { require "config/lx-erp.conf"; };
+  eval { require "config/lx-erp-local.conf"; } if -f "config/lx-erp-local.conf";
+
+  $::cgi  = CGI->new qw();
+  $::form = Form->new;
+  $::auth = SL::Auth->new;
+
+  die 'cannot reach auth db'               unless $::auth->session_tables_present;
+
+  $::auth->restore_session;
+
+  require "bin/mozilla/common.pl";
+
+  die "cannot find user $login"            unless %::myconfig = $::auth->read_user($login);
+  die "cannot find locale for user $login" unless $::locale   = Locale->new($::myconfig{countrycode});
+
+  return "logged in as $login";
+}
+
+# these function provides a load command to slurp in a lx-office module
+# since it's seldomly useful, it's not documented in help
+sub load {
+  my $module = shift;
+  $module =~ s/[^\w]//g;
+  require "bin/mozilla/$module.pl";
+}
+
+sub reload {
+  use Module::Reload;
+  Module::Reload->check();
+
+  return "modules reloaded";
+}
+
+sub quit {
+  exit;
+}
+
+sub help {
+  print <<EOL;
+
+  Lx-Office 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
+
+EOL
+#  load   'module'     - läd das angegebene Modul, d.h. bin/mozilla/module.pl und SL/Module.pm.
+}
+
+sub pp {
+  $Data::Dumper::Indent   = 2;
+  $Data::Dumper::Maxdepth = 2;
+  Data::Dumper::Dumper(@_);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+scripts/console - Lx Office Console
+
+=head1 SYNOPSIS
+
+  ./script/console
+  > help               # displays a brief documentation
+
+=head1 DESCRIPTION
+
+Users of Ruby on Rails will recognize this as a perl reimplementation of the
+rails scripts/console. It's intend is to provide a shell environment to the
+lx-office internals. This will mostly not interest you if you just want to do
+your ERP stuff with lx-office, but will be invaluable for those who wish to
+make changes to lx-office itself.
+
+=head1 FUNCTIONS
+
+You can do most things in the console that you could do in an actual perl
+script. Certain helper functions will aid you in debugging the state of the
+program:
+
+=head2 pp C<DATA>
+
+Named after the rails pretty print gem, this will call Data::Dumper on the
+given C<DATA>. Use it to see what is going on.
+
+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 lxinit C<login>
+
+Login into lx-office using a specified login. No password will be required, and
+security mechanisms will mostly be inactive. form, locale, myconfig will be
+correctly set.
+
+=head2 reload
+
+Attempts to reload modules that changed since last reload (or inital startup).
+This will mostly work just fine, except for Moose classes that have been made
+immutable. Keep in mind that existing objects will continue to have the methods
+of the classes they were created with.
+
+=head1 BUGS
+
+ - Reload on immutable Moose classes is buggy.
+ - Logging in more than once is not supported by the program, and thus not by
+   the console. It seems to work, but strange things may happen.
+
+=head1 SEE ALSO
+
+Configuration of this script is located in:
+
+ config/console.conf
+ config/console.conf.default
+
+See there for interesting options.
+
+=head1 AUTHOR
+
+  Sven Schöling <s.schoeling@linet-services.de>
+
+=cut
index f1dcf93..bef04f0 100755 (executable)
@@ -355,7 +355,7 @@ eval { require "config/lx-erp.conf"; };
 eval { require "config/lx-erp-local.conf"; } if (-f "config/lx-erp-local.conf");
 
 $form = Form->new();
-$locale = Locale->new("de", "login");
+$locale = Locale->new("de");
 
 #######
 #######