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
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;
require_main_code($script, $suffix);
$::cgi = CGI->new('');
- $::locale = Locale->new($::language, $script);
+ $::locale = Locale->new($::language);
$::form = Form->new;
$::form->{script} = $script . $suffix;
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);
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;
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');
sub filter {
my ($self, $text, $args) = @_;
- return $locale->text($text, @{ $args || [] }) || $text;
+ return $::locale->text($text, @{ $args || [] }) || $text;
}
return 'SL::Template::Plugin::T8';
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);
our $cgi;
our $form;
-our $locale;
our $auth;
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();
}
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();
$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();
}
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();
}
# 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();
}
$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};
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';
use strict;
-my $locale;
-
1;
# end of main
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;
. 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>
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";
use strict;
-my $locale;
-
1;
# end of main
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)
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";
my $ml = $item;
$label =~ s/$level--//g;
$ml =~ s/--.*//;
- $label = $locale->text($label);
+ $label = $::locale->text($label);
$label =~ s/ / /g;
$menu->{$item}{target} = "main_window" unless $menu->{$item}{target};
use strict;
-my $locale;
-
1;
# end of main
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;
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")) {
use strict;
my $menufile = "menu.ini";
-my $locale;
1;
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";
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";
use strict;
my $menufile = "menu.ini";
-my $locale;
1;
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";
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";
--- /dev/null
+#!/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
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");
#######
#######