summaryrefslogtreecommitdiff
path: root/old-handler.pl
diff options
context:
space:
mode:
authoreinhverfr <einhverfr@4979c152-3d1c-0410-bac9-87ea11338e46>2007-06-26 19:02:03 +0000
committereinhverfr <einhverfr@4979c152-3d1c-0410-bac9-87ea11338e46>2007-06-26 19:02:03 +0000
commit78d2ecf7d8ee85d943f26a0df35a7c40e3ecb913 (patch)
tree145857243ed85adac2e8c2b4d43203c86db8a0a4 /old-handler.pl
parent8dd3af0e1497f938bee47da502b0e697f52eb198 (diff)
Fixing ordering issue for LedgerSMB.pm
git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@1331 4979c152-3d1c-0410-bac9-87ea11338e46
Diffstat (limited to 'old-handler.pl')
-rwxr-xr-xold-handler.pl206
1 files changed, 206 insertions, 0 deletions
diff --git a/old-handler.pl b/old-handler.pl
new file mode 100755
index 00000000..3b98cb0d
--- /dev/null
+++ b/old-handler.pl
@@ -0,0 +1,206 @@
+#!/usr/bin/perl
+#
+######################################################################
+# LedgerSMB Accounting and ERP
+
+# http://www.ledgersmb.org/
+#
+# Copyright (C) 2006
+# This work contains copyrighted information from a number of sources all used
+# with permission.
+#
+# This file contains source code included with or based on SQL-Ledger which
+# is Copyright Dieter Simader and DWS Systems Inc. 2000-2005 and licensed
+# under the GNU General Public License version 2 or, at your option, any later
+# version. For a full list including contact information of contributors,
+# maintainers, and copyright holders, see the CONTRIBUTORS file.
+#
+# Original Copyright Notice from SQL-Ledger 2.6.17 (before the fork):
+# Copyright (C) 2001
+#
+# Author: Dieter Simader
+# Email: dsimader@sql-ledger.org
+# Web: http://www.sql-ledger.org
+#
+# Contributors:
+#
+#
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#######################################################################
+#
+# this script is the frontend called from bin/$terminal/$script
+# all the accounting modules are linked to this script which in
+# turn execute the same script in bin/$terminal/
+#
+#######################################################################
+
+use LedgerSMB::Sysconfig;
+use Digest::MD5;
+use Error qw(:try);
+
+$| = 1;
+
+use LedgerSMB::User;
+use LedgerSMB::Form;
+use LedgerSMB::Locale;
+use LedgerSMB::Session;
+use Data::Dumper;
+require "common.pl";
+
+# for custom preprocessing logic
+eval { require "custom.pl"; };
+
+$form = new Form;
+
+# name of this script
+$0 =~ tr/\\/\//;
+$pos = rindex $0, '/';
+$script = substr( $0, $pos + 1 );
+
+$locale = LedgerSMB::Locale->get_handle( ${LedgerSMB::Sysconfig::language} )
+ or $form->error( __FILE__ . ':' . __LINE__ . ": Locale not loaded: $!\n" );
+
+# we use $script for the language module
+$form->{script} = $script;
+
+# strip .pl for translation files
+$script =~ s/\.pl//;
+
+# pull in DBI
+use DBI qw(:sql_types);
+
+# send warnings to browser
+$SIG{__WARN__} = sub { $form->info( $_[0] ) };
+
+# send errors to browser
+$SIG{__DIE__} =
+ sub { $form->error( __FILE__ . ':' . __LINE__ . ': ' . $_[0] ) };
+
+## did sysadmin lock us out
+#if (-f "${LedgerSMB::Sysconfig::userspath}/nologin") {
+# $locale = LedgerSMB::Locale->get_handle(${LedgerSMB::Sysconfig::language}) or
+# $form->error(__FILE__.':'.__LINE__.": Locale not loaded: $!\n");
+# $form->{charset} = 'UTF-8';
+# $locale->encoding('UTF-8');
+#
+# $form->{callback} = "";
+# $form->error(__FILE__.':'.__LINE__.': '.$locale->text('System currently down for maintenance!'));
+#}
+
+&check_password;
+
+# grab user config. This is ugly and unecessary if/when
+# we get rid of myconfig and use User as a real object
+%myconfig = %{ LedgerSMB::User->fetch_config( $form->{login} ) };
+$locale = LedgerSMB::Locale->get_handle( $myconfig{countrycode} )
+ or $form->error( __FILE__ . ':' . __LINE__ . ": Locale not loaded: $!\n" );
+
+# locale messages
+#$form->{charset} = $locale->encoding;
+$form->{charset} = 'UTF-8';
+$locale->encoding('UTF-8');
+
+if ($@) {
+ $form->{callback} = "";
+ $msg1 = $locale->text('You are logged out!');
+ $msg2 = $locale->text('Login');
+ $form->redirect(
+ "$msg1 <p><a href=\"login.pl\" target=\"_top\">$msg2</a></p>");
+}
+
+map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout)
+ unless ( $form->{type} eq 'preferences' );
+
+$form->db_init( \%myconfig );
+
+# pull in the main code
+require "bin/$form->{script}";
+
+# customized scripts
+if ( -f "bin/custom/$form->{script}" ) {
+ eval { require "bin/custom/$form->{script}"; };
+}
+
+# customized scripts for login
+if ( -f "bin/custom/$form->{login}_$form->{script}" ) {
+ eval { require "bin/custom/$form->{login}_$form->{script}"; };
+}
+
+if ( $form->{action} ) {
+
+ # window title bar, user info
+ $form->{titlebar} =
+ "LedgerSMB "
+ . $locale->text('Version')
+ . " $form->{version} - $myconfig{name} - $myconfig{dbname}";
+
+ &{ $form->{action} };
+
+}
+else {
+ $form->error( __FILE__ . ':' . __LINE__ . ': '
+ . $locale->text('action= not defined!') );
+}
+
+1;
+
+# end
+
+sub check_password {
+
+ require "bin/pw.pl";
+
+ if ( $form->{password} ) {
+ if (
+ !Session::password_check(
+ $form, $form->{login}, $form->{password}
+ )
+ )
+ {
+ if ( $ENV{GATEWAY_INTERFACE} ) {
+ &getpassword;
+ }
+ else {
+ $form->error( __FILE__ . ':' . __LINE__ . ': '
+ . $locale->text('Access Denied!') );
+ }
+ exit;
+ }
+ else {
+ Session::session_create($form);
+ }
+
+ }
+ else {
+ if ( $ENV{GATEWAY_INTERFACE} ) {
+ $ENV{HTTP_COOKIE} =~ s/;\s*/;/g;
+ @cookies = split /;/, $ENV{HTTP_COOKIE};
+ foreach (@cookies) {
+ ( $name, $value ) = split /=/, $_, 2;
+ $cookie{$name} = $value;
+ }
+
+ #check for valid session
+ if ( !Session::session_check( $cookie{"LedgerSMB"}, $form ) ) {
+ &getpassword(1);
+ exit;
+ }
+ }
+ else {
+ exit;
+ }
+ }
+}
+