Revision 619bf139
Von Sven Schöling vor etwa 15 Jahren hinzugefügt
| am.pl | ||
|---|---|---|
| 30 | 30 |
# |
| 31 | 31 |
####################################################################### |
| 32 | 32 |
|
| 33 |
#use strict; |
|
| 34 |
|
|
| 33 | 35 |
BEGIN {
|
| 34 | 36 |
unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML). |
| 35 | 37 |
push @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version. |
| 36 | 38 |
} |
| 37 | 39 |
|
| 38 | 40 |
# setup defaults, DO NOT CHANGE |
| 39 |
$userspath = "users"; |
|
| 40 |
$templates = "templates"; |
|
| 41 |
$memberfile = "users/members"; |
|
| 42 |
$sendmail = "| /usr/sbin/sendmail -t"; |
|
| 41 |
$main::userspath = "users";
|
|
| 42 |
$main::templates = "templates";
|
|
| 43 |
$main::memberfile = "users/members";
|
|
| 44 |
$main::sendmail = "| /usr/sbin/sendmail -t";
|
|
| 43 | 45 |
########## end ########################################### |
| 44 | 46 |
|
| 45 | 47 |
$| = 1; |
| 46 | 48 |
|
| 47 | 49 |
use SL::LXDebug; |
| 48 |
$lxdebug = LXDebug->new(); |
|
| 50 |
$main::lxdebug = LXDebug->new();
|
|
| 49 | 51 |
|
| 50 | 52 |
use CGI qw( -no_xhtml); |
| 51 | 53 |
use SL::Auth; |
| ... | ... | |
| 67 | 69 |
|
| 68 | 70 |
require "bin/mozilla/common.pl"; |
| 69 | 71 |
|
| 70 |
if (defined($latex) && !defined($latex_templates)) {
|
|
| 71 |
$latex_templates = $latex;
|
|
| 72 |
undef($latex); |
|
| 72 |
if (defined($main::latex) && !defined($main::latex_templates)) {
|
|
| 73 |
$main::latex_templates = $main::latex;
|
|
| 74 |
undef($main::latex);
|
|
| 73 | 75 |
} |
| 74 | 76 |
|
| 75 | 77 |
# this prevents most of the tabindexes being created by CGI. |
| ... | ... | |
| 79 | 81 |
|
| 80 | 82 |
# name of this script |
| 81 | 83 |
$0 =~ tr/\\/\//; |
| 82 |
$pos = rindex $0, '/'; |
|
| 83 |
$script = substr($0, $pos + 1); |
|
| 84 |
my $pos = rindex $0, '/';
|
|
| 85 |
my $script = substr($0, $pos + 1);
|
|
| 84 | 86 |
|
| 85 | 87 |
# we use $script for the language module |
| 86 | 88 |
$form->{script} = $script;
|
| ... | ... | |
| 92 | 94 |
use DBI; |
| 93 | 95 |
|
| 94 | 96 |
# locale messages |
| 95 |
$locale = new Locale($language, "$script"); |
|
| 97 |
$main::locale = new Locale($main::language, "$script"); |
|
| 98 |
my $locale = $main::locale; |
|
| 96 | 99 |
|
| 97 | 100 |
# did sysadmin lock us out |
| 98 |
if (-e "$userspath/nologin") {
|
|
| 101 |
if (-e "$main::userspath/nologin") {
|
|
| 99 | 102 |
$form->error($locale->text('System currently down for maintenance!'));
|
| 100 | 103 |
} |
| 101 | 104 |
|
| ... | ... | |
| 105 | 108 |
|
| 106 | 109 |
$form->{login} =~ s|.*/||;
|
| 107 | 110 |
|
| 108 |
%myconfig = $auth->read_user($form->{login});
|
|
| 111 |
%main::myconfig = $auth->read_user($form->{login});
|
|
| 112 |
my %myconfig = %main::myconfig; |
|
| 109 | 113 |
|
| 110 | 114 |
if (!$myconfig{login}) {
|
| 111 | 115 |
_show_error('login/password_error', 'password');
|
| ... | ... | |
| 157 | 161 |
sub _show_error {
|
| 158 | 162 |
my $template = shift; |
| 159 | 163 |
my $error_type = shift; |
| 160 |
$locale = Locale->new($language, 'all');
|
|
| 164 |
my $locale = Locale->new($main::language, 'all');
|
|
| 161 | 165 |
$form->{error} = $locale->text('The session is invalid or has expired.') if ($error_type eq 'session');
|
| 162 | 166 |
$form->{error} = $locale->text('Incorrect password!.') if ($error_type eq 'password');
|
| 163 |
$myconfig{countrycode} = $language;
|
|
| 167 |
$myconfig{countrycode} = $main::language;
|
|
| 164 | 168 |
$form->{stylesheet} = 'css/lx-office-erp.css';
|
| 165 | 169 |
|
| 166 | 170 |
$form->header(); |
Auch abrufbar als: Unified diff
am.pl strictness