sql-ledger/VERSION0000644000175000017500000000000612147747631014337 0ustar dsimaderdsimader3.0.5 sql-ledger/admin.pl0000755000175000017500000000527211355744254014727 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # this script sets up the terminal and runs the scripts # in bin/$terminal directory # admin.pl is linked to this script # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; %printer = (); ########## end ########################################### $| = 1; eval { require "sql-ledger.conf"; }; if ($ENV{CONTENT_LENGTH}) { read(STDIN, $_, $ENV{CONTENT_LENGTH}); } if ($ENV{QUERY_STRING}) { $_ = $ENV{QUERY_STRING}; } if ($ARGV[0]) { $_ = $ARGV[0]; } %form = split /[&=]/; # fix for apache 2.0 bug map { $form{$_} =~ s/\\$// } keys %form; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); @scripts = qw(login.pl admin.pl custom_login.pl custom_admin.pl); if (grep !/^\Q$form{script}\E/, @scripts) { print "Content-Type: text/html\n\n" if $ENV{HTTP_USER_AGENT}; print "\nAccess denied!\n"; exit; } if (-f "$userspath/nologin.LCK" && $script ne 'admin.pl') { print "Content-Type: text/html\n\n" if $ENV{HTTP_USER_AGENT}; if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); print "\n$message\n"; } else { print "\nLogin disabled!\n"; } exit; } if ($form{path}) { $form{path} =~ s/%2f/\//gi; $form{path} =~ s/\.\.//g; if ($form{path} !~ /^bin\//) { print "Content-Type: text/html\n\n" if $ENV{HTTP_USER_AGENT}; print "\nInvalid path!\n"; exit; } $ARGV[0] = "$_&script=$script"; require "$form{path}/$script"; } else { if (!$form{terminal}) { if ($ENV{HTTP_USER_AGENT}) { # web browser $form{terminal} = "lynx"; if ($ENV{HTTP_USER_AGENT} !~ /lynx/i) { $form{terminal} = "mozilla"; } } else { if ($ENV{TERM} =~ /xterm/) { $form{terminal} = "xterm"; } if ($ENV{TERM} =~ /(console|linux|vt.*)/i) { $form{terminal} = "console"; } } } if ($form{terminal}) { $form{terminal} =~ s/%2f/\//gi; $form{terminal} =~ s/\.\.//g; $ARGV[0] = "path=bin/$form{terminal}&script=$script"; map { $ARGV[0] .= "&${_}=$form{$_}" } keys %form; require "bin/$form{terminal}/$script"; } else { print "Content-Type: text/html\n\n" if $ENV{HTTP_USER_AGENT}; print qq|\nUnknown terminal\n|; } } 1; # end of main sql-ledger/am.pl0000755000175000017500000001212411320750425014213 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/ap.pl0000755000175000017500000001212411320750425014216 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/ar.pl0000755000175000017500000001212411320750425014220 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/bp.pl0000755000175000017500000001212411320750425014217 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/ca.pl0000755000175000017500000001212411320750425014201 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/cp.pl0000755000175000017500000001212411320750425014220 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/ct.pl0000755000175000017500000001212411320750425014224 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/favicon.ico0000664000175000017500000000101612110222723015370 0ustar dsimaderdsimader ø( (¤-©<ŠY;½eCw„pÈ‚epš‹Ö¢dº¸éȹWÏÕŒÞá¸ëëÕóõûóêÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿõÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿñçÿÿÿÿÿÿÿÿðWÿðõÿÿÿÿÿº«ÿÿÿÿÿ÷ÿÿÿÿSÿÿªªªªÿÿÿÿÿÿÿÿÿ_ÿúªªªª¯ùÿÿÿÿÿÿÿÿúªªŠª_ÿÿÿÿÿúúªªª ¢oÿÿÿÿÿÿûÚªª Š ¯ÿÿÿÿÿÿúúªª ª ¯ÿÿÿÿÿÿÿýªª ªªÿÿÿÿÿÿÿªªªJªÿÿÿÿÿÿÿÿªªªªªª¯ÿÿÿÿÿÿÿÿúúúªªªª¯ÿÿÿÿÿÿÿÿÿª¯ªªªªÿÿÿÿÿÿÿÿÿÿººªªª«ÿÿÿÿÿÿÿÿÿÿý¯ª¯ªßÿÿÿÿÿÿÿÿÿÿÿý¬ÊÏÿÿÿÿÿÿÿÿÿÿÿÿ÷ÿÿÿûÿÿÿóÿÿà3ÿù:Oü?ûüðÿýàÿàqÿ wÿ€wÿ wÿàwÿÀ÷ÿÀÿÿ¨ÿÿÄÿÿÀÿÿäGÿÿøÿÿsql-ledger/gl.pl0000755000175000017500000001212411320750425014220 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/hr.pl0000755000175000017500000001212411320750425014227 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/ic.pl0000755000175000017500000001212411320750425014211 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/im.pl0000755000175000017500000001212411320750425014223 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/index.html0000644000175000017500000000026110147430163015252 0ustar dsimaderdsimader SQL-Ledger

SQL-Ledger

Login
sql-ledger/ir.pl0000755000175000017500000001212411320750425014230 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/is.pl0000755000175000017500000001212411320750425014231 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/jc.pl0000755000175000017500000001212411320750425014212 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/login.pl0000755000175000017500000000527211355744254014747 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # this script sets up the terminal and runs the scripts # in bin/$terminal directory # admin.pl is linked to this script # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; %printer = (); ########## end ########################################### $| = 1; eval { require "sql-ledger.conf"; }; if ($ENV{CONTENT_LENGTH}) { read(STDIN, $_, $ENV{CONTENT_LENGTH}); } if ($ENV{QUERY_STRING}) { $_ = $ENV{QUERY_STRING}; } if ($ARGV[0]) { $_ = $ARGV[0]; } %form = split /[&=]/; # fix for apache 2.0 bug map { $form{$_} =~ s/\\$// } keys %form; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); @scripts = qw(login.pl admin.pl custom_login.pl custom_admin.pl); if (grep !/^\Q$form{script}\E/, @scripts) { print "Content-Type: text/html\n\n" if $ENV{HTTP_USER_AGENT}; print "\nAccess denied!\n"; exit; } if (-f "$userspath/nologin.LCK" && $script ne 'admin.pl') { print "Content-Type: text/html\n\n" if $ENV{HTTP_USER_AGENT}; if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); print "\n$message\n"; } else { print "\nLogin disabled!\n"; } exit; } if ($form{path}) { $form{path} =~ s/%2f/\//gi; $form{path} =~ s/\.\.//g; if ($form{path} !~ /^bin\//) { print "Content-Type: text/html\n\n" if $ENV{HTTP_USER_AGENT}; print "\nInvalid path!\n"; exit; } $ARGV[0] = "$_&script=$script"; require "$form{path}/$script"; } else { if (!$form{terminal}) { if ($ENV{HTTP_USER_AGENT}) { # web browser $form{terminal} = "lynx"; if ($ENV{HTTP_USER_AGENT} !~ /lynx/i) { $form{terminal} = "mozilla"; } } else { if ($ENV{TERM} =~ /xterm/) { $form{terminal} = "xterm"; } if ($ENV{TERM} =~ /(console|linux|vt.*)/i) { $form{terminal} = "console"; } } } if ($form{terminal}) { $form{terminal} =~ s/%2f/\//gi; $form{terminal} =~ s/\.\.//g; $ARGV[0] = "path=bin/$form{terminal}&script=$script"; map { $ARGV[0] .= "&${_}=$form{$_}" } keys %form; require "bin/$form{terminal}/$script"; } else { print "Content-Type: text/html\n\n" if $ENV{HTTP_USER_AGENT}; print qq|\nUnknown terminal\n|; } } 1; # end of main sql-ledger/menu.ini0000644000175000017500000006524611773107726014754 0ustar dsimaderdsimader[ ] [AR] [AR--Add Transaction] module=ar.pl action=add type=transaction [AR--Sales Invoice] module=is.pl action=add type=invoice [AR--Credit Note] module=ar.pl action=add type=credit_note [AR--Credit Invoice] module=is.pl action=add type=credit_invoice [AR--Reports] module=menu.pl action=acc_menu target=acc_menu submenu=1 [AR--Reports--Transactions] module=ar.pl action=search nextsub=transactions [AR--Reports--Outstanding] module=ar.pl action=search outstanding=1 nextsub=transactions [AR--Reports--AR Aging] module=rp.pl action=report reportcode=ar_aging [AR--Reports--Reminder] module=rp.pl action=report reportcode=reminder [AR--Reports--Tax collected] module=rp.pl action=report reportcode=tax_collected [AR--Reports--Non-taxable] module=rp.pl action=report reportcode=nontaxable_sales [AR--Generate] module=menu.pl action=acc_menu target=acc_menu submenu=1 [AR--Generate--Sales Invoices] module=is.pl action=generate type=invoice [POS] [POS--Sale] module=ps.pl action=add nextsub=openinvoices [POS--Open] module=ps.pl action=openinvoices [POS--Receipts] module=ps.pl action=receipts [Customers] [Customers--Add Customer] module=ct.pl action=add db=customer [Customers--Reports] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Customers--Reports--Search] module=ct.pl action=search db=customer [Customers--Reports--History] module=ct.pl action=history db=customer [AP] [AP--Add Transaction] module=ap.pl action=add type=transaction [AP--Vendor Invoice] module=ir.pl action=add type=invoice [AP--Debit Note] module=ap.pl action=add type=debit_note [AP--Debit Invoice] module=ir.pl action=add type=debit_invoice [AP--Reports] module=menu.pl action=acc_menu target=acc_menu submenu=1 [AP--Reports--Transactions] module=ap.pl action=search nextsub=transactions [AP--Reports--Outstanding] module=ap.pl action=search outstanding=1 nextsub=transactions [AP--Reports--AP Aging] module=rp.pl action=report reportcode=ap_aging [AP--Reports--Tax paid] module=rp.pl action=report reportcode=tax_paid [AP--Reports--Non-taxable] module=rp.pl action=report reportcode=nontaxable_purchases [Vendors] [Vendors--Add Vendor] module=ct.pl action=add db=vendor [Vendors--Reports] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Vendors--Reports--Search] module=ct.pl action=search db=vendor [Vendors--Reports--History] module=ct.pl action=history db=vendor [Cash] [Cash--Receipt] module=cp.pl action=payment type=receipt [Cash--Receipts] module=cp.pl action=payments type=receipt [Cash--Payment] module=cp.pl action=payment type=check [Cash--Payments] module=cp.pl action=payments type=check [Cash--FX Adjustment] module=gl.pl action=add fxadj=1 [Cash--Reconciliation] module=rc.pl action=reconciliation [Cash--Reports] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Cash--Reports--Receipts] module=rp.pl action=report reportcode=receipts [Cash--Reports--Payments] module=rp.pl action=report reportcode=payments [Cash--Reports--Reconciliation] module=rc.pl action=reconciliation report=1 [Vouchers] [Vouchers--Payable] module=vr.pl action=payable_batch [Vouchers--Payment] module=vr.pl action=payment_batch [Vouchers--Payments] module=vr.pl action=payments_batch [Vouchers--Payment Reversal] module=vr.pl action=payment_reversal_batch [Vouchers--General Ledger] module=vr.pl action=general_ledger_batch [Vouchers--Reports] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Vouchers--Reports--All Batches] module=vr.pl action=search [Vouchers--Reports--Payable] module=vr.pl action=search batch=ap [Vouchers--Reports--Payment] module=vr.pl action=search batch=payment [Vouchers--Reports--Payment Reversal] module=vr.pl action=search batch=payment_reversal [Vouchers--Reports--General Ledger] module=vr.pl action=search batch=gl [HR] [HR--Employees] module=menu.pl action=acc_menu target=acc_menu submenu=1 [HR--Employees--Add Employee] module=hr.pl action=add db=employee [HR--Employees--Reports] module=hr.pl action=search db=employee [HR--Payroll] module=menu.pl action=acc_menu target=acc_menu submenu=1 [HR--Payroll--Add Transaction] module=hr.pl action=add db=payroll [HR--Payroll--Transactions] module=hr.pl action=search db=payroll [HR--Payroll--Setup] module=menu.pl action=acc_menu target=acc_menu submenu=1 [HR--Payroll--Setup--Wages] module=hr.pl action=search db=wage [HR--Payroll--Setup--Deductions] module=hr.pl action=search db=deduction [Order Entry] [Order Entry--Sales Order] module=oe.pl action=add type=sales_order [Order Entry--Purchase Order] module=oe.pl action=add type=purchase_order [Order Entry--Reports] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Order Entry--Reports--Sales Orders] module=oe.pl action=search type=sales_order [Order Entry--Reports--Requirements] module=ic.pl action=so_requirements [Order Entry--Reports--Purchase Orders] module=oe.pl action=search type=purchase_order [Order Entry--Generate] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Order Entry--Generate--Purchase Orders] module=oe.pl action=search type=generate_purchase_order [Order Entry--Consolidate] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Order Entry--Consolidate--Sales Orders] module=oe.pl action=search type=consolidate_sales_order [Order Entry--Consolidate--Purchase Orders] module=oe.pl action=search type=consolidate_purchase_order [Shipping] [Shipping--Ship] module=oe.pl action=search type=ship_order [Shipping--Receive] module=oe.pl action=search type=receive_order [Shipping--Transfer] module=oe.pl action=search_transfer [Quotations] [Quotations--Quotation] module=oe.pl action=add type=sales_quotation [Quotations--RFQ] module=oe.pl action=add type=request_quotation [Quotations--Reports] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Quotations--Reports--Quotations] module=oe.pl action=search type=sales_quotation [Quotations--Reports--RFQs] module=oe.pl action=search type=request_quotation [General Ledger] [General Ledger--Add Transaction] module=gl.pl action=add [General Ledger--Reports] module=gl.pl action=search [Goods & Services] [Goods & Services--Add Part] module=ic.pl action=add item=part [Goods & Services--Add Service] module=ic.pl action=add item=service [Goods & Services--Add Assembly] module=ic.pl action=add item=assembly [Goods & Services--Add Labor/Overhead] module=ic.pl action=add item=labor [Goods & Services--Add Group] module=pe.pl action=add type=partsgroup [Goods & Services--Add Pricegroup] module=pe.pl action=add type=pricegroup [Goods & Services--Stock Assembly] module=ic.pl action=stock_assembly [Goods & Services--Changeup] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Goods & Services--Changeup--Assembly] module=ic.pl action=search searchitems=assembly changeup=1 [Goods & Services--Changeup--Part] module=ic.pl action=search searchitems=part changeup=1 [Goods & Services--Changeup--Service] module=ic.pl action=search searchitems=service changeup=1 [Goods & Services--Changeup--Labor/Overhead] module=ic.pl action=search searchitems=labor changeup=1 [Goods & Services--Reports] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Goods & Services--Reports--All Items] module=ic.pl action=search searchitems=all [Goods & Services--Reports--Parts] module=ic.pl action=search searchitems=part [Goods & Services--Reports--Requirements] module=ic.pl action=requirements [Goods & Services--Reports--Services] module=ic.pl action=search searchitems=service [Goods & Services--Reports--Labor/Overhead] module=ic.pl action=search searchitems=labor [Goods & Services--Reports--Groups] module=pe.pl action=search type=partsgroup [Goods & Services--Reports--Pricegroups] module=pe.pl action=search type=pricegroup [Goods & Services--Reports--Assemblies] module=ic.pl action=search searchitems=assembly [Goods & Services--Reports--Components] module=ic.pl action=search searchitems=component [Goods & Services--Translations] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Goods & Services--Translations--Description] module=pe.pl action=translation translation=description [Goods & Services--Translations--Groups] module=pe.pl action=translation translation=partsgroup [Projects] [Projects--Add Project] module=pe.pl action=add type=project [Projects--Add Time Card] module=jc.pl action=add type=timecard project=project [Projects--Reports] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Projects--Reports--Projects] module=pe.pl action=search type=project [Projects--Reports--Transactions] module=rp.pl action=report reportcode=projects [Projects--Reports--Time Cards] module=jc.pl action=search type=timecard project=project [Projects--Generate] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Projects--Generate--Sales Orders] module=pe.pl action=project_sales_order [Projects--Translations] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Projects--Translations--Description] module=pe.pl action=translation translation=project [Reports] [Reports--Chart of Accounts] module=ca.pl action=chart_of_accounts [Reports--Trial Balance] module=rp.pl action=report reportcode=trial_balance [Reports--Income Statement] module=rp.pl action=report reportcode=income_statement [Reports--Balance Sheet] module=rp.pl action=report reportcode=balance_sheet [Recurring Transactions] module=am.pl action=recurring_transactions [Batch] [Batch--Print] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Batch--Print--Sales Invoices] module=bp.pl action=search type=invoice vc=customer batch=print [Batch--Print--Remittance Vouchers] module=bp.pl action=search type=remittance_voucher vc=customer batch=print [Batch--Print--Sales Orders] module=bp.pl action=search type=sales_order batch=print [Batch--Print--Work Orders] module=bp.pl action=search type=work_order batch=print [Batch--Print--Quotations] module=bp.pl action=search type=sales_quotation batch=print [Batch--Print--Packing Lists] module=bp.pl action=search type=packing_list batch=print [Batch--Print--Pick Lists] module=bp.pl action=search type=pick_list batch=print [Batch--Print--Vendor Invoices] module=bp.pl action=search type=invoice vc=vendor batch=print [Batch--Print--Purchase Orders] module=bp.pl action=search type=purchase_order batch=print [Batch--Print--Bin Lists] module=bp.pl action=search type=bin_list batch=print [Batch--Print--RFQs] module=bp.pl action=search type=request_quotation batch=print [Batch--Print--Time Cards] module=bp.pl action=search type=timecard batch=print [Batch--Email] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Batch--Email--Sales Invoices] module=bp.pl action=search type=invoice vc=customer batch=email [Batch--Email--Remittance Vouchers] module=bp.pl action=search type=remittance_voucher vc=customer batch=email [Batch--Email--Sales Orders] module=bp.pl action=search type=sales_order batch=email [Batch--Email--Work Orders] module=bp.pl action=search type=work_order batch=email [Batch--Email--Quotations] module=bp.pl action=search type=sales_quotation batch=email [Batch--Email--Packing Lists] module=bp.pl action=search type=packing_list batch=email [Batch--Email--Pick Lists] module=bp.pl action=search type=pick_list batch=email [Batch--Email--Vendor Invoices] module=bp.pl action=search type=invoice vc=vendor batch=email [Batch--Email--Purchase Orders] module=bp.pl action=search type=purchase_order batch=email [Batch--Email--Bin Lists] module=bp.pl action=search type=bin_list batch=email [Batch--Email--RFQs] module=bp.pl action=search type=request_quotation batch=email [Batch--Queue] module=menu.pl action=acc_menu target=acc_menu submenu=1 [Batch--Queue--Sales Invoices] module=bp.pl action=search type=invoice vc=customer batch=queue [Batch--Queue--Remittance Vouchers] module=bp.pl action=search type=remittance_voucher vc=customer batch=queue [Batch--Queue--Sales Orders] module=bp.pl action=search type=sales_order batch=queue [Batch--Queue--Work Orders] module=bp.pl action=search type=work_order batch=queue [Batch--Queue--Quotations] module=bp.pl action=search type=sales_quotation batch=queue [Batch--Queue--Packing Lists] module=bp.pl action=search type=packing_list batch=queue [Batch--Queue--Pick Lists] module=bp.pl action=search type=pick_list batch=queue [Batch--Queue--Vendor Invoices] module=bp.pl action=search type=invoice vc=vendor batch=queue [Batch--Queue--Purchase Orders] module=bp.pl action=search type=purchase_order batch=queue [Batch--Queue--Bin Lists] module=bp.pl action=search type=bin_list batch=queue [Batch--Queue--RFQs] module=bp.pl action=search type=request_quotation batch=queue [Batch--Queue--Time Cards] module=bp.pl action=search type=timecard batch=queue [Exchange Rates] module=am.pl action=search_exchangerates [Import] [Import--Customers] module=im.pl action=import type=customer [Import--Vendors] module=im.pl action=import type=vendor [Import--Parts] module=im.pl action=import type=part [Import--Services] module=im.pl action=import type=service [Import--Labor/Overhead] module=im.pl action=import type=labor [Import--Sales Invoices] module=im.pl action=import type=sales_invoice [Import--Groups] module=im.pl action=import type=partsgroup [Import--Payments] module=im.pl action=import type=payment [Import--Sales Orders] module=im.pl action=import type=sales_order [Import--Purchase Orders] module=im.pl action=import type=purchase_order [Import--Chart of Accounts] module=im.pl action=import type=coa [Export] [Export--Payments] module=im.pl action=export type=payment [System] [System--Defaults] module=am.pl action=defaults [System--Audit Control] module=am.pl action=audit_control [System--Bank Accounts] module=am.pl action=bank_accounts [System--Taxes] module=am.pl action=taxes [System--Currencies] module=am.pl action=list_currencies [System--Payment Methods] module=am.pl action=list_paymentmethod [System--Workstations] module=am.pl action=workstations [System--Roles] module=am.pl action=list_roles [System--Warehouses] module=am.pl action=list_warehouse [System--Departments] module=am.pl action=list_department [System--Type of Business] module=am.pl action=list_business [System--Language] module=am.pl action=list_language [System--SIC] module=am.pl action=list_sic [System--Yearend] module=am.pl action=yearend [System--Maintenance] module=menu.pl action=acc_menu target=acc_menu submenu=1 [System--Maintenance--Delete Invoices] module=sm.pl action=delete_invoices [System--Maintenance--Repost Invoices] module=sm.pl action=repost_invoices [System--Maintenance--Mapfile] module=am.pl action=list_templates file=templates=import.map [System--Maintenance--Clear Semaphores] module=am.pl action=clear_semaphores [System--Maintenance--Lock Dataset] module=am.pl action=lock_dataset [System--Maintenance--Unlock Dataset] module=am.pl action=unlock_dataset [System--Maintenance--Restore] module=am.pl action=restore [System--Maintenance--Monitor] module=am.pl action=monitor [System--Backup] module=menu.pl action=acc_menu target=acc_menu submenu=1 [System--Backup--Send by E-Mail] module=am.pl action=backup media=email [System--Backup--Save to File] module=am.pl action=backup media=file [System--Chart of Accounts] module=menu.pl action=acc_menu target=acc_menu submenu=1 [System--Chart of Accounts--Add Account] module=am.pl action=add_account [System--Chart of Accounts--List Accounts] module=am.pl action=list_account [System--Chart of Accounts--Translations] module=pe.pl action=translation translation=chart [System--Chart of Accounts--Add GIFI] module=am.pl action=add_gifi [System--Chart of Accounts--List GIFI] module=am.pl action=list_gifi [System--html Templates] module=menu.pl action=acc_menu target=acc_menu submenu=1 [System--html Templates--Income Statement] module=am.pl action=list_templates file=templates=/income_statement.html [System--html Templates--Balance Sheet] module=am.pl action=list_templates file=templates=/balance_sheet.html [System--html Templates--Sales Invoice] module=am.pl action=list_templates file=templates=/invoice.html [System--html Templates--Credit Invoice] module=am.pl action=list_templates file=templates=/credit_invoice.html [System--html Templates--Vendor Invoice] module=am.pl action=list_templates file=templates=/vendor_invoice.html [System--html Templates--Debit Invoice] module=am.pl action=list_templates file=templates=/debit_invoice.html [System--html Templates--AR Transaction] module=am.pl action=list_templates file=templates=/ar_transaction.html [System--html Templates--AP Transaction] module=am.pl action=list_templates file=templates=/ap_transaction.html [System--html Templates--Credit Note] module=am.pl action=list_templates file=templates=/credit_note.html [System--html Templates--Debit Note] module=am.pl action=list_templates file=templates=/debit_note.html [System--html Templates--Remittance Voucher] module=am.pl action=list_templates file=templates=/remittance_voucher.html [System--html Templates--Packing List] module=am.pl action=list_templates file=templates=/packing_list.html [System--html Templates--Pick List] module=am.pl action=list_templates file=templates=/pick_list.html [System--html Templates--Sales Order] module=am.pl action=list_templates file=templates=/sales_order.html [System--html Templates--Work Order] module=am.pl action=list_templates file=templates=/work_order.html [System--html Templates--Purchase Order] module=am.pl action=list_templates file=templates=/purchase_order.html [System--html Templates--Bin List] module=am.pl action=list_templates file=templates=/bin_list.html [System--html Templates--Statement] module=am.pl action=list_templates file=templates=/statement.html [System--html Templates--1.Reminder] module=am.pl action=list_templates file=templates=/reminder1.html [System--html Templates--2.Reminder] module=am.pl action=list_templates file=templates=/reminder2.html [System--html Templates--3.Reminder] module=am.pl action=list_templates file=templates=/reminder3.html [System--html Templates--Check] module=am.pl action=list_templates file=templates=/check.html [System--html Templates--Receipt] module=am.pl action=list_templates file=templates=/receipt.html [System--html Templates--Quotation] module=am.pl action=list_templates file=templates=/sales_quotation.html [System--html Templates--RFQ] module=am.pl action=list_templates file=templates=/request_quotation.html [System--html Templates--Time Card] module=am.pl action=list_templates file=templates=/timecard.html [System--html Templates--Payslip] module=am.pl action=list_templates file=templates=/payslip.html [System--XML Templates] module=menu.pl action=acc_menu target=acc_menu submenu=1 [System--XML Templates--Sales Invoice] module=am.pl action=list_templates file=templates=/invoice.xml [System--XML Templates--Credit Invoice] module=am.pl action=list_templates file=templates=/credit_invoice.xml [System--XML Templates--Vendor Invoice] module=am.pl action=list_templates file=templates=/vendor_invoice.xml [System--XML Templates--Debit Invoice] module=am.pl action=list_templates file=templates=/debit_invoice.xml [System--XML Templates--AR Transaction] module=am.pl action=list_templates file=templates=/ar_transaction.xml [System--XML Templates--AP Transaction] module=am.pl action=list_templates file=templates=/ap_transaction.xml [System--XML Templates--Credit Note] module=am.pl action=list_templates file=templates=/credit_note.xml [System--XML Templates--Debit Note] module=am.pl action=list_templates file=templates=/debit_note.xml [System--XML Templates--Remittance Voucher] module=am.pl action=list_templates file=templates=/remittance_voucher.xml [System--XML Templates--Packing List] module=am.pl action=list_templates file=templates=/packing_list.xml [System--XML Templates--Pick List] module=am.pl action=list_templates file=templates=/pick_list.xml [System--XML Templates--Sales Order] module=am.pl action=list_templates file=templates=/sales_order.xml [System--XML Templates--Work Order] module=am.pl action=list_templates file=templates=/work_order.xml [System--XML Templates--Purchase Order] module=am.pl action=list_templates file=templates=/purchase_order.xml [System--XML Templates--Bin List] module=am.pl action=list_templates file=templates=/bin_list.xml [System--XML Templates--Statement] module=am.pl action=list_templates file=templates=/statement.xml [System--XML Templates--1.Reminder] module=am.pl action=list_templates file=templates=/reminder1.xml [System--XML Templates--2.Reminder] module=am.pl action=list_templates file=templates=/reminder2.xml [System--XML Templates--3.Reminder] module=am.pl action=list_templates file=templates=/reminder3.xml [System--XML Templates--Check] module=am.pl action=list_templates file=templates=/check.xml [System--XML Templates--Receipt] module=am.pl action=list_templates file=templates=/receipt.xml [System--XML Templates--Quotation] module=am.pl action=list_templates file=templates=/sales_quotation.xml [System--XML Templates--RFQ] module=am.pl action=list_templates file=templates=/request_quotation.xml [System--XML Templates--Time Card] module=am.pl action=list_templates file=templates=/timecard.xml [System--XML Templates--Payslip] module=am.pl action=list_templates file=templates=/payslip.xml [System--LaTeX Templates] module=menu.pl action=acc_menu target=acc_menu submenu=1 [System--LaTeX Templates--Sales Invoice] module=am.pl action=list_templates file=templates=/invoice.tex [System--LaTeX Templates--Credit Invoice] module=am.pl action=list_templates file=templates=/credit_invoice.tex [System--LaTeX Templates--Vendor Invoice] module=am.pl action=list_templates file=templates=/vendor_invoice.tex [System--LaTeX Templates--Debit Invoice] module=am.pl action=list_templates file=templates=/debit_invoice.tex [System--LaTeX Templates--AR Transaction] module=am.pl action=list_templates file=templates=/ar_transaction.tex [System--LaTeX Templates--AP Transaction] module=am.pl action=list_templates file=templates=/ap_transaction.tex [System--LaTeX Templates--Credit Note] module=am.pl action=list_templates file=templates=/credit_note.tex [System--LaTeX Templates--Debit Note] module=am.pl action=list_templates file=templates=/debit_note.tex [System--LaTeX Templates--Remittance Voucher] module=am.pl action=list_templates file=templates=/remittance_voucher.tex [System--LaTeX Templates--Packing List] module=am.pl action=list_templates file=templates=/packing_list.tex [System--LaTeX Templates--Pick List] module=am.pl action=list_templates file=templates=/pick_list.tex [System--LaTeX Templates--Sales Order] module=am.pl action=list_templates file=templates=/sales_order.tex [System--LaTeX Templates--Work Order] module=am.pl action=list_templates file=templates=/work_order.tex [System--LaTeX Templates--Purchase Order] module=am.pl action=list_templates file=templates=/purchase_order.tex [System--LaTeX Templates--Bin List] module=am.pl action=list_templates file=templates=/bin_list.tex [System--LaTeX Templates--Statement] module=am.pl action=list_templates file=templates=/statement.tex [System--LaTeX Templates--1.Reminder] module=am.pl action=list_templates file=templates=/reminder1.tex [System--LaTeX Templates--2.Reminder] module=am.pl action=list_templates file=templates=/reminder2.tex [System--LaTeX Templates--3.Reminder] module=am.pl action=list_templates file=templates=/reminder3.tex [System--LaTeX Templates--Check] module=am.pl action=list_templates file=templates=/check.tex [System--LaTeX Templates--Receipt] module=am.pl action=list_templates file=templates=/receipt.tex [System--LaTeX Templates--Quotation] module=am.pl action=list_templates file=templates=/sales_quotation.tex [System--LaTeX Templates--RFQ] module=am.pl action=list_templates file=templates=/request_quotation.tex [System--LaTeX Templates--Time Card] module=am.pl action=list_templates file=templates=/timecard.tex [System--LaTeX Templates--Barcode] module=am.pl action=list_templates file=templates=/barcode.tex [System--LaTeX Templates--Payslip] module=am.pl action=list_templates file=templates=/payslip.tex [System--Text Templates] module=menu.pl action=acc_menu target=acc_menu submenu=1 [System--Text Templates--POS Invoice] module=am.pl action=list_templates file=templates=/pos_invoice.txt [System--Text Templates--Sales Invoice] module=am.pl action=list_templates file=templates=/invoice.txt [System--Text Templates--Credit Invoice] module=am.pl action=list_templates file=templates=/credit_invoice.txt [System--Text Templates--Vendor Invoice] module=am.pl action=list_templates file=templates=/vendor_invoice.txt [System--Text Templates--Debit Invoice] module=am.pl action=list_templates file=templates=/debit_invoice.txt [System--Text Templates--AR Transaction] module=am.pl action=list_templates file=templates=/ar_transaction.txt [System--Text Templates--AP Transaction] module=am.pl action=list_templates file=templates=/ap_transaction.txt [System--Text Templates--Credit Note] module=am.pl action=list_templates file=templates=/credit_note.txt [System--Text Templates--Debit Note] module=am.pl action=list_templates file=templates=/debit_note.txt [System--Text Templates--Remittance Voucher] module=am.pl action=list_templates file=templates=/remittance_voucher.txt [System--Text Templates--Packing List] module=am.pl action=list_templates file=templates=/packing_list.txt [System--Text Templates--Pick List] module=am.pl action=list_templates file=templates=/pick_list.txt [System--Text Templates--Sales Order] module=am.pl action=list_templates file=templates=/sales_order.txt [System--Text Templates--Work Order] module=am.pl action=list_templates file=templates=/work_order.txt [System--Text Templates--Purchase Order] module=am.pl action=list_templates file=templates=/purchase_order.txt [System--Text Templates--Bin List] module=am.pl action=list_templates file=templates=/bin_list.txt [System--Text Templates--Statement] module=am.pl action=list_templates file=templates=/statement.txt [System--Text Templates--1.Reminder] module=am.pl action=list_templates file=templates=/reminder1.txt [System--Text Templates--2.Reminder] module=am.pl action=list_templates file=templates=/reminder2.txt [System--Text Templates--3.Reminder] module=am.pl action=list_templates file=templates=/reminder3.txt [System--Text Templates--Check] module=am.pl action=list_templates file=templates=/check.txt [System--Text Templates--Receipt] module=am.pl action=list_templates file=templates=/receipt.txt [System--Text Templates--Quotation] module=am.pl action=list_templates file=templates=/sales_quotation.txt [System--Text Templates--RFQ] module=am.pl action=list_templates file=templates=/request_quotation.txt [System--Text Templates--Time Card] module=am.pl action=list_templates file=templates=/timecard.txt [System--Text Templates--Payslip] module=am.pl action=list_templates file=templates=/payslip.txt [Stylesheet] module=am.pl action=display_stylesheet [Preferences] module=am.pl action=config [Version] module=am.pl action=company_logo [Logout] module=login.pl action=logout target=_top sql-ledger/menu.pl0000755000175000017500000001212411320750425014562 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/oe.pl0000755000175000017500000001212411320750425014221 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/pe.pl0000755000175000017500000001212411320750425014222 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/ps.pl0000755000175000017500000001212411320750425014240 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/rc.pl0000755000175000017500000001212411320750425014222 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/rp.pl0000755000175000017500000001212411320750425014237 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/sm.pl0000755000175000017500000001212411320750425014235 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/vr.pl0000755000175000017500000001212411320750425014245 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP # Copyright (C) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # ####################################################################### # # 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/ # ####################################################################### # setup defaults, DO NOT CHANGE $userspath = "users"; $spool = "spool"; $templates = "templates"; $images = "images"; $memberfile = "users/members"; $sendmail = "| /usr/sbin/sendmail -t"; $latex = 0; %printer = (); ########## end ########################################### $| = 1; use SL::Form; eval { require "sql-ledger.conf"; }; $form = new Form $userspath; # name of this script $0 =~ tr/\\/\//; $pos = rindex $0, '/'; $script = substr($0, $pos + 1); # 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); $form->{login} =~ s/(\.\.|\/|\\|\x00)//g; # check for user config file, could be missing or ??? eval { require("$userspath/$form->{login}.conf"); }; if ($@) { $locale = new Locale "$language", "$script"; $form->{callback} = ""; $msg1 = $locale->text('You are logged out!'); $msg2 = $locale->text('Login'); $form->redirect("$msg1

$msg2"); exit; } # locale messages $locale = new Locale "$myconfig{countrycode}", "$script"; $form->{charset} = $locale->{charset}; # send warnings to browser $SIG{__WARN__} = sub { eval { $form->info($_[0]); } }; # send errors to browser $SIG{__DIE__} = sub { eval { $form->error($_[0]); exit; } }; $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; map { $form->{$_} = $myconfig{$_} } qw(stylesheet timeout) unless ($form->{type} eq 'preferences'); $form->{path} =~ s/\.\.//g; if ($form->{path} !~ /^bin\//) { $form->error($locale->text('Invalid path!')."\n"); } # global lock out if (-f "$userspath/nologin.LCK") { if (-s "$userspath/nologin.LCK") { open(FH, "$userspath/nologin.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('System currently down for maintenance!')); } # dataset lock out if (-f "$userspath/$myconfig{dbname}.LCK" && $form->{login} ne "admin\@$myconfig{dbname}") { if (-s "$userspath/$myconfig{dbname}.LCK") { open(FH, "$userspath/$myconfig{dbname}.LCK"); $message = ; close(FH); $form->error($message); } $form->error($locale->text('Dataset currently down for maintenance!')); } # pull in the main code require "$form->{path}/$form->{script}"; # customized scripts if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; } # customized scripts for login if (-f "$form->{path}/$form->{login}_$form->{script}") { eval { require "$form->{path}/$form->{login}_$form->{script}"; }; } if ($form->{action}) { # window title bar, user info $form->{titlebar} = "SQL-Ledger ".$locale->text('Version'). " $form->{version} - $myconfig{name} - $myconfig{dbname}"; &check_password; if (substr($form->{action}, 0, 1) =~ /( |\.)/) { &{ $form->{nextsub} }; } else { &{ $locale->findsub($form->{action}) }; } } else { $form->error($locale->text('action= not defined!')); } 1; # end sub check_password { if ($myconfig{password}) { require "$form->{path}/pw.pl"; if ($form->{password}) { if ((crypt $form->{password}, substr($form->{login}, 0, 2)) ne $myconfig{password}) { if ($ENV{HTTP_USER_AGENT}) { &getpassword; } else { $form->error($locale->text('Access Denied!')); } exit; } else { # password checked out, create session if ($ENV{HTTP_USER_AGENT}) { # create new session use SL::User; $user = new User $memberfile, $form->{login}; $user->{password} = $form->{password}; $user->create_config("$userspath/$form->{login}.conf"); $form->{sessioncookie} = $user->{sessioncookie}; } } } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } if ($cookie{"SL-$form->{login}"}) { $form->{sessioncookie} = $cookie{"SL-$form->{login}"}; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($myconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie{"SL-$form->{login}"}, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length $form->{login}; $login = substr($s, 0, $l); $password = substr($s, $l, (length $s) - ($l + 10)); # validate cookie if (($login ne $form->{login}) || ($myconfig{password} ne crypt $password, substr($form->{login}, 0, 2))) { &getpassword(1); exit; } } else { if ($form->{action} ne 'display') { &getpassword(1); exit; } } } else { exit; } } } } sql-ledger/setup.pl0000755000175000017500000002420111203334235014752 0ustar dsimaderdsimader#!/usr/bin/perl # ###################################################################### # SQL-Ledger ERP Installer # Copyright (c) 2007, DWS Systems Inc. # # Web: http://www.sql-ledger.com # ####################################################################### $| = 1; if ($ENV{HTTP_USER_AGENT}) { print " This does not work yet! use $0 from the command line"; exit; } $lynx = `lynx -version`; # if LWP is not installed use lynx $wget = `wget --version 2>&1`; $gzip = `gzip -V 2>&1`; # gz decompression utility $tar = `tar --version 2>&1`; # tar archiver $latex = `latex -version`; %checkversion = ( www => 1, abacus => 2 ); %source = ( 1 => { url => "http://www.sql-ledger.com/source", site => "www.sql-ledger.com", locale => us }, 2 => { url => "http://abacus.sql-ledger.com/source", site => "abacus.sql-ledger.com", locale => ca }, ); $userspath = "users"; # default for new installation eval { require "sql-ledger.conf"; }; $filename = shift; chomp $filename; $newinstall = 1; # is LWP installed eval { require LWP::Simple; }; $lwp = !($@); unless ($lwp || $wget || $lynx || $filename) { die "You must have either lynx, wget or LWP installed or specify a filename. perl $0 \n"; } if ($filename) { # extract version die "Not a SQL-Ledger archive\n" if ($filename !~ /^sql-ledger/); $version = $filename; $version =~ s/sql-ledger-(\d+\.\d+\.\d+).*$/$1/; } if (-f "VERSION") { # get installed version from VERSION file open(FH, "VERSION"); @a = ; close(FH); $version = $a[0]; chomp $version; $newinstall = !$version; if (! -f "sql-ledger.conf") { $newinstall = 1; } } $webowner = "nobody"; $webgroup = "nogroup"; if ($httpd = `find /etc /usr/local/etc -type f -name 'httpd*.conf'`) { chomp $httpd; $webowner = `grep "^User " $httpd`; $webgroup = `grep "^Group " $httpd`; chomp $webowner; chomp $webgroup; ($null, $webowner) = split / /, $webowner; ($null, $webgroup) = split / /, $webgroup; } if ($confd = `find /etc /usr/local/etc -type d -name 'apache*/conf.d'`) { chomp $confd; } system("tput clear"); if ($filename) { $install = "\ninstall $version from (f)ile\n"; } # check for latest version &get_latest_version; chomp $latest_version; if (!$newinstall) { $install .= "\n(r)einstall $version\n"; } if ($version && $latest_version) { if (calcversion($version) < calcversion($latest_version)) { $install .= "\n(u)pgrade to $latest_version\n"; } } $install .= "\n(i)nstall $latest_version (from Internet)\n" if $latest_version; $install .= "\n(d)ownload $latest_version (no installation)" unless $filename; print qq| SQL-Ledger ERP Installation $install Enter: |; $a = ; chomp $a; exit unless $a; $a = lc $a; if ($a !~ /d/) { print qq|\nEnter httpd owner [$webowner] : |; $web = ; chomp $web; $webowner = $web if $web; print qq|\nEnter httpd group [$webgroup] : |; $web = ; chomp $web; $webgroup = $web if $web; } if ($a eq 'd') { &download; } if ($a =~ /(i|u)/) { &install; } if ($a eq 'r') { $latest_version = $version; &install; } if ($a eq 'f') { &install; } exit; # end main sub calcversion { my $v = shift; @v = split /\./, $v; for (0 .. 2) { $v[$_] = 1000 + $v[$_]; } return join '', @v; } sub download { &get_source_code; } sub get_latest_version { print "Checking for latest version number ....\n"; if ($filename) { print "skipping, filename supplied\n"; return; } if ($lwp) { $found = 0; foreach $source (qw(www abacus)) { $url = $source{$checkversion{$source}}{url}; print "$source{$checkversion{$source}}{site} ... "; $latest_version = LWP::Simple::get("$url/latest_version"); if ($latest_version) { $found = 1; last; } else { print "not found\n"; } } if (! $found) { $lwp = 0; &get_latest_version; } } elsif ($wget) { $found = 0; foreach $source (qw(www abacus)) { $url = $source{$checkversion{$source}}{url}; print "$source{$checkversion{$source}}{site} ... "; if ($latest_version = `wget -q -O - $url/latest_version`) { $found = 1; last; } else { print "not found\n"; } } if (! $found) { $wget = 0; &get_latest_version; } } else { if (!$lynx) { print "\nYou must have either wget, lynx or LWP installed"; exit 1; } foreach $source (qw(www abacus)) { $url = $source{$checkversion{$source}}{url}; print "$source{$checkversion{$source}}{site} ... "; $ok = `lynx -dump -head $url/latest_version`; if ($ok = ($ok =~ s/HTTP.*?200 //)) { $latest_version = `lynx -dump $url/latest_version`; last; } else { print "not found\n"; } } die unless $ok; } if ($latest_version) { print "ok\n"; } } sub get_source_code { $err = 0; @order = (); for (sort { $a <=> $b } keys %source) { push @order, $_; } if ($latest_version) { # download it chomp $latest_version; $latest_version = "sql-ledger-${latest_version}.tar.gz"; print "\nStatus\n"; print "Downloading $latest_version .... "; foreach $key (@order) { print "\n$source{$key}{site} .... "; if ($lwp) { $err = LWP::Simple::getstore("$source{$key}{url}/$latest_version", "$latest_version"); $err -= 200; } elsif ($wget) { $ok = `wget -Sqc $source{$key}{url}/$latest_version`; if ($ok =~ /HTTP.*?(20|416)/) { $err = 0; } } else { $ok = `lynx -dump -head $source{$key}{url}/$latest_version`; $err = !($ok =~ s/HTTP.*?200 //); if (!$err) { $err = system("lynx -dump $source{$key}{url}/$latest_version > $latest_version"); } } if ($err) { print "failed!"; } else { last; } } } else { $err = -1; } if ($err) { die "Cannot get $latest_version"; } else { print "ok\n"; } $latest_version; } sub install { if ($filename) { $latest_version = $filename; } else { $latest_version = &get_source_code; } &decompress; if ($newinstall) { open(FH, "sql-ledger.conf.default"); @f = ; close(FH); unless ($latex) { grep { s/^\$latex.*/\$latex = 0;/ } @f; } open(FH, ">sql-ledger.conf"); print FH @f; close(FH); $alias = $absolutealias = $ENV{'PWD'}; $alias =~ s/.*\///g; $httpddir = `dirname $httpd`; if ($confd) { $httpddir = $confd; } chomp $httpddir; $filename = "sql-ledger-httpd.conf"; # do we have write permission? if (!open(FH, ">>$httpddir/$filename")) { open(FH, ">$filename"); $norw = 1; } $directives = qq| Alias /$alias $absolutealias/ AllowOverride All AddHandler cgi-script .pl Options ExecCGI Includes FollowSymlinks Order Allow,Deny Allow from All Order Deny,Allow Deny from All |; print FH $directives; close(FH); print qq| This is a new installation. |; if ($norw) { print qq| Webserver directives were written to $filename Copy $filename to $httpddir |; if (!$confd) { print qq| and add # SQL-Ledger Include $httpddir/$filename to $httpd |; } print qq| and restart your webserver!\n|; if (!$permset) { print qq| WARNING: permissions for templates, users, css and spool directory could not be set. Login as root and set permissions # chown -hR :$webgroup users templates css spool # chmod 771 users templates css spool |; } } else { print qq| Webserver directives were written to $httpddir/$filename |; if (!$confd) { if (!(`grep "^# SQL-Ledger" $httpd`)) { print qq|Please add # SQL-Ledger Include $httpddir/$filename to your httpd configuration file and restart the web server. |; } } } } # if this is not root, check if user is part of $webgroup if ($>) { if ($permset = ($) =~ getgrnam $webgroup)) { `chown -hR :$webgroup users templates css spool`; chmod 0771, 'users', 'templates', 'css', 'spool'; `chown :$webgroup sql-ledger.conf`; } } else { # root `chown -hR 0:0 *`; `chown -hR $webowner:$webgroup users templates css spool`; chmod 0771, 'users', 'templates', 'css', 'spool'; `chown $webowner:$webgroup sql-ledger.conf`; } chmod 0644, 'sql-ledger.conf'; unlink "sql-ledger.conf.default"; &cleanup; while ($a !~ /(Y|N)/) { print qq|\nDisplay README (Y/n) : |; $a = ; chomp $a; $a = ($a) ? uc $a : 'Y'; if ($a eq 'Y') { @args = ("more", "doc/README"); system(@args); } } } sub decompress { die "Error: gzip not installed\n" unless ($gzip); die "Error: tar not installed\n" unless ($tar); &create_lockfile; # ungzip and extract source code print "Decompressing $latest_version ... "; if (system("gzip -df $latest_version")) { print "Error: Could not decompress $latest_version\n"; &remove_lockfile; exit; } else { print "done\n"; } # strip gz from latest_version $latest_version =~ s/\.gz//; # now untar it print "Unpacking $latest_version ... "; if (system("tar -xf $latest_version")) { print "Error: Could not unpack $latest_version\n"; &remove_lockfile; exit; } else { # now we have a copy in sql-ledger if (system("tar -cf $latest_version -C sql-ledger .")) { print "Error: Could not create archive for $latest_version\n"; &remove_lockfile; exit; } else { if (system("tar -xf $latest_version")) { print "Error: Could not unpack $latest_version\n"; &remove_lockfile; exit; } else { print "done\n"; print "cleaning up ... "; `rm -rf sql-ledger`; print "done\n"; } } } } sub create_lockfile { if (-d "$userspath") { open(FH, ">$userspath/nologin.LCK"); close(FH); } } sub cleanup { unlink "$latest_version"; unlink "$userspath/members.default" if (-f "$userspath/members.default"); &remove_lockfile; } sub remove_lockfile { unlink "$userspath/nologin.LCK" if (-f "$userspath/nologin.LCK") }; sql-ledger/sql-ledger.conf.default0000644000175000017500000000135311736137731017623 0ustar dsimaderdsimaderuse vars qw($userspath $spool $memberfile $templates $sendmail $images $language $sid $latex $gzip $dvipdf); # path to user configuration files $userspath = "users"; # spool directory for batch printing $spool = "spool"; # templates base directory $templates = "templates"; # member file $memberfile = "users/members"; # location of sendmail $sendmail = "| /usr/sbin/sendmail -t"; # location for images $images = "images"; # set language for login and admin $language = ""; # if you have latex installed set to 1 #$latex = 1; # program to use for file compression #$gzip = "gzip -S .gz"; # use dvipdf instead of pdflatex for PDF #$dvipdf = 1; # if the server can't find gzip or latex add the path #$ENV{PATH} .= ":/usr/local/bin"; 1; sql-ledger/bin/mozilla/0000755000175000017500000000000012140773041015475 5ustar dsimaderdsimadersql-ledger/bin/mozilla/sm.pl0000644000175000017500000000661711332572241016464 0ustar dsimaderdsimader#===================================================================== # SQL-Ledger ERP # Copyright (c) 2009 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # #====================================================================== # # Maintainance module # #====================================================================== use SL::SM; use SL::IS; use SL::IR; 1; # end of main sub repost_invoices { # enter a date for which to repost invoices # reverse invoices and save in temporary tables # post vendor invoices then sales invoices $form->helpref("repost_invoices", $myconfig{countrycode}); $form->{title} = $locale->text('Repost Invoices'); $form->header; print qq|

{script}>
$form->{helpref}$form->{title}
|.$locale->text('Beginning date').qq|

|; $form->{nextsub} = "do_repost_invoices"; $form->hide_form(qw(nextsub path login)); print qq|
|; } sub do_repost_invoices { $form->isblank('transdate', $locale->text('Date missing')); $form->header; print "Reposting Invoices ... "; if ($ENV{HTTP_USER_AGENT}) { print "please wait\n"; } else { print "please wait\n"; } $SIG{INT} = 'IGNORE'; open(FH, ">$userspath/$myconfig{dbname}.LCK") or $form->error($!); close(FH); $err = SM->repost_invoices(\%myconfig, \%$form, $userspath); unlink "$userspath/$myconfig{dbname}.LCK"; if ($err == -1) { $form->error('AR account does not exist!'); } if ($err == -2) { $form->error('AP account does not exist!'); } print "... done\n"; } sub delete_invoices { $form->{title} = $locale->text('Delete Open Invoices'); $form->helpref("delete_open_invoices", $myconfig{countrycode}); $form->header; print qq|
{script}>
$form->{helpref}$form->{title}
|.$locale->text('From').qq| |.$locale->text('To').qq|

|; $form->{nextsub} = "do_delete_invoices"; $form->hide_form(qw(nextsub path login)); print qq|
|; } sub do_delete_invoices { $form->header; print $locale->text('Deleting Invoices ... '); if ($ENV{HTTP_USER_AGENT}) { print "".$locale->text('please wait')."\n"; } else { print $locale->text('please wait')."\n"; } $SIG{INT} = 'IGNORE'; IS->delete_invoices(\%myconfig, \%$form, $spool); print "... ".$locale->text('done'); } sub continue { &{ $form->{nextsub} } }; sql-ledger/bin/mozilla/aa.pl0000644000175000017500000025254012067130430016420 0ustar dsimaderdsimader#===================================================================== # SQL-Ledger ERP # Copyright (c) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # #====================================================================== # # AR / AP # #====================================================================== # any custom scripts for this one if (-f "$form->{path}/custom_aa.pl") { eval { require "$form->{path}/custom_aa.pl"; }; } if (-f "$form->{path}/$form->{login}_aa.pl") { eval { require "$form->{path}/$form->{login}_aa.pl"; }; } use SL::VR; 1; # end of main # this is for our long dates # $locale->text('January') # $locale->text('February') # $locale->text('March') # $locale->text('April') # $locale->text('May ') # $locale->text('June') # $locale->text('July') # $locale->text('August') # $locale->text('September') # $locale->text('October') # $locale->text('November') # $locale->text('December') # this is for our short month # $locale->text('Jan') # $locale->text('Feb') # $locale->text('Mar') # $locale->text('Apr') # $locale->text('May') # $locale->text('Jun') # $locale->text('Jul') # $locale->text('Aug') # $locale->text('Sep') # $locale->text('Oct') # $locale->text('Nov') # $locale->text('Dec') # $locale->text('Add AR Transaction') # $locale->text('Edit AR Transaction') # $locale->text('Add AP Transaction') # $locale->text('Edit AP Transaction') # $locale->text('Add AP Voucher') # $locale->text('Edit AP Voucher') # $locale->text('Add Credit Note') # $locale->text('Edit Credit Note') # $locale->text('Add Debit Note') # $locale->text('Edit Debit Note') sub add { &create_links; %title = ( transaction => "$form->{ARAP} Transaction", credit_note => 'Credit Note', debit_note => 'Debit Note' ); $arap = lc $form->{ARAP}; if ($form->{batch}) { $title = "Add $form->{ARAP} Voucher"; $form->{title} = $locale->text($title); $form->helpref("${arap}_voucher", $myconfig{countrycode}); if ($form->{batchdescription}) { $form->{title} .= " / $form->{batchdescription}"; } } else { $title = "Add $title{$form->{type}}"; $form->{title} = $locale->text($title); $form->helpref("${arap}_$form->{type}", $myconfig{countrycode}); } $form->{callback} = "$form->{script}?action=add&type=$form->{type}&path=$form->{path}&login=$form->{login}" unless $form->{callback}; $form->{focus} = "amount_1"; &display_form; } sub edit { &create_links; %title = ( transaction => "$form->{ARAP} Transaction", credit_note => 'Credit Note', debit_note => 'Debit Note' ); if ($form->{batch}) { $title = "Edit $form->{ARAP} Voucher"; $form->{title} = $locale->text($title); if ($form->{batchdescription}) { $form->{title} .= " / $form->{batchdescription}"; } } else { $title = "Edit $title{$form->{type}}"; $form->{title} = $locale->text($title); } $arap = lc $form->{ARAP}; $form->helpref("${arap}_$form->{type}", $myconfig{countrycode}); &display_form; } sub display_form { &form_header; &form_footer; } sub create_links { $readonly = $form->{readonly}; $form->create_links($form->{ARAP}, \%myconfig, $form->{vc}); $form->{readonly} ||= $readonly; for (qw(duedate taxincluded terms cashdiscount discountterms payment_accno payment_method)) { $temp{$_} = $form->{$_} } $temp{$form->{ARAP}} = $form->{$form->{ARAP}}; if (exists $form->{oldinvtotal} && $form->{oldinvtotal} < 0) { $form->{type} = ($form->{vc} eq 'customer') ? 'credit_note' : 'debit_note'; for (qw(invtotal totalpaid)) { $form->{"old$_"} *= -1 } } $form->{type} ||= "transaction"; $form->{formname} ||= $form->{type}; $form->{format} ||= $myconfig{outputformat}; $form->{selectprinter} = ""; for (@{ $form->{all_printer} }) { $form->{selectprinter} .= "$_->{printer}\n" } chomp $form->{selectprinter}; if ($myconfig{printer}) { $form->{format} ||= "postscript"; } else { $form->{format} ||= "pdf"; } $form->{media} ||= $myconfig{printer}; # $locale->text('Transaction') # $locale->text('Credit Note') # $locale->text('Debit Note') %selectform = ( transaction => 'Transaction', credit_note => 'Credit Note', debit_note => 'Debit Note' ); $form->{selectformname} = qq|$form->{type}--|.$locale->text($selectform{$form->{type}}); if ($latex) { if (!$form->{batch}) { if ($form->{ARAP} eq 'AR') { if ($form->{type} eq 'credit_note') { $form->{selectformname} .= qq|\ncheck--|.$locale->text('Check'); } else { $form->{selectformname} .= qq|\nreceipt--|.$locale->text('Receipt'); } } else { if ($form->{type} eq 'debit_note') { $form->{selectformname} .= qq|\nreceipt--|.$locale->text('Receipt'); } else { $form->{selectformname} .= qq|\ncheck--|.$locale->text('Check'); } } } } if (!$form->{batch}) { if ($form->{ARAP} eq 'AR') { if ($form->{type} eq 'transaction') { $form->{selectformname} .= qq|\nremittance_voucher--|.$locale->text('Remittance Voucher') if $form->{remittancevoucher}; } } } # currencies @curr = split /:/, $form->{currencies}; $form->{defaultcurrency} = $curr[0]; chomp $form->{defaultcurrency}; for (@curr) { $form->{selectcurrency} .= "$_\n" } AA->get_name(\%myconfig, \%$form); $form->{currency} =~ s/ //g; $form->{duedate} = $temp{duedate} if $temp{duedate}; if ($form->{id}) { for (keys %temp) { $form->{$_} = $temp{$_} }; } $form->{"old$form->{vc}"} = qq|$form->{$form->{vc}}--$form->{"$form->{vc}_id"}|; $form->{"old$form->{vc}number"} = $form->{"$form->{vc}number"}; for (qw(transdate duedate currency)) { $form->{"old$_"} = $form->{$_} } # customers/vendors $form->{"select$form->{vc}"} = ""; if (@{ $form->{"all_$form->{vc}"} }) { $form->{$form->{vc}} = qq|$form->{$form->{vc}}--$form->{"$form->{vc}_id"}|; for (@{ $form->{"all_$form->{vc}"} }) { $form->{"select$form->{vc}"} .= qq|$_->{name}--$_->{id}\n| } } # departments if (@{ $form->{all_department} }) { $form->{selectdepartment} = "\n"; $form->{department} = "$form->{department}--$form->{department_id}" if $form->{department_id}; for (@{ $form->{all_department} }) { $form->{selectdepartment} .= qq|$_->{description}--$_->{id}\n| } } $form->{employee} = "$form->{employee}--$form->{employee_id}"; # sales staff if (@{ $form->{all_employee} }) { $form->{selectemployee} = "\n"; for (@{ $form->{all_employee} }) { $form->{selectemployee} .= qq|$_->{name}--$_->{id}\n| } } # projects if (@{ $form->{all_project} }) { $form->{selectprojectnumber} = "\n"; for (@{ $form->{all_project} }) { $form->{selectprojectnumber} .= qq|$_->{projectnumber}--$_->{id}\n| } } if (@{ $form->{all_language} }) { $form->{selectlanguage} = "\n"; for (@{ $form->{all_language} }) { $form->{selectlanguage} .= qq|$_->{code}--$_->{description}\n| } } $form->{roundchange} = "=$form->{roundchange}"; # paymentmethod if (@{ $form->{all_paymentmethod} }) { $form->{selectpaymentmethod} = "\n"; $form->{paymentmethod} = "$form->{paymentmethod}--$form->{paymentmethod_id}" if $form->{paymentmethod_id}; for (@{ $form->{all_paymentmethod} }) { $form->{selectpaymentmethod} .= qq|$_->{description}--$_->{id}\n|; if ($_->{roundchange}) { $form->{roundchange} .= ";$_->{description}--$_->{id}=$_->{roundchange}" } } } # reference $i = 0; for (@{ $form->{all_reference} }) { $i++; $form->{"referencedescription_$i"} = $_->{description}; $form->{"referenceid_$i"} = $_->{id}; } $form->{reference_rows} = $i; $form->{"select$form->{vc}"} = $form->escape($form->{"select$form->{vc}"},1); for (qw(formname currency department employee projectnumber language paymentmethod printer)) { $form->{"select$_"} = $form->escape($form->{"select$_"},1) } $form->{roundchange} = $form->escape($form->{roundchange},1); $netamount = 0; $tax = 0; $taxrate = 0; $ml = ($form->{ARAP} eq 'AR') ? 1 : -1; $ml *= -1 if $form->{type} =~ /_note/; foreach $key (keys %{ $form->{"$form->{ARAP}_links"} }) { $form->{"select$key"} = ""; foreach $ref (@{ $form->{"$form->{ARAP}_links"}{$key} }) { if ($key eq "$form->{ARAP}_tax") { $form->{"select$form->{ARAP}_tax_$ref->{accno}"} = $form->escape("$ref->{accno}--$ref->{description}",1); next; } $form->{"select$key"} .= "$ref->{accno}--$ref->{description}\n"; } $form->{"select$key"} = $form->escape($form->{"select$key"},1); # if there is a value we have an old entry for $i (1 .. scalar @{ $form->{acc_trans}{$key} }) { if ($key eq "$form->{ARAP}_paid") { $form->{"$form->{ARAP}_paid_$i"} = "$form->{acc_trans}{$key}->[$i-1]->{accno}--$form->{acc_trans}{$key}->[$i-1]->{description}"; $form->{"paid_$i"} = $form->{acc_trans}{$key}->[$i-1]->{amount} * -1 * $ml; $form->{"datepaid_$i"} = $form->{acc_trans}{$key}->[$i-1]->{transdate}; $form->{"olddatepaid_$i"} = $form->{acc_trans}{$key}->[$i-1]->{transdate}; $form->{"source_$i"} = $form->{acc_trans}{$key}->[$i-1]->{source}; $form->{"memo_$i"} = $form->{acc_trans}{$key}->[$i-1]->{memo}; $form->{"exchangerate_$i"} = $form->{acc_trans}{$key}->[$i-1]->{exchangerate}; $form->{"cleared_$i"} = $form->{acc_trans}{$key}->[$i-1]->{cleared}; $form->{"vr_id_$i"} = $form->{acc_trans}{$key}->[$i-1]->{vr_id}; $form->{"paymentmethod_$i"} = "$form->{acc_trans}{$key}->[$i-1]->{paymentmethod}--$form->{acc_trans}{$key}->[$i-1]->{paymentmethod_id}"; $form->{paidaccounts}++; } elsif ($key eq "$form->{ARAP}_discount") { $form->{"$form->{ARAP}_discount_paid"} = "$form->{acc_trans}{$key}->[$i-1]->{accno}--$form->{acc_trans}{$key}->[0]->{description}"; $form->{"discount_paid"} = $form->{acc_trans}{$key}->[0]->{amount} * -1 * $ml; $form->{"discount_datepaid"} = $form->{acc_trans}{$key}->[0]->{transdate}; $form->{"olddiscount_datepaid"} = $form->{acc_trans}{$key}->[0]->{transdate}; $form->{"discount_source"} = $form->{acc_trans}{$key}->[0]->{source}; $form->{"discount_memo"} = $form->{acc_trans}{$key}->[0]->{memo}; $form->{"discount_exchangerate"} = $form->{acc_trans}{$key}->[0]->{exchangerate}; $form->{"discount_cleared"} = $form->{acc_trans}{$key}->[0]->{cleared}; $form->{"discount_paymentmethod"} = "$form->{acc_trans}{$key}->[0]->{paymentmethod_id}--$form->{acc_trans}{$key}->[0]->{paymentmethod}"; } else { $akey = $key; $akey =~ s/$form->{ARAP}_//; if ($key eq "$form->{ARAP}_tax") { if (! $form->{acc_trans}{$key}->[$i-1]->{id}) { $form->{"${key}_$form->{acc_trans}{$key}->[$i-1]->{accno}"} = "$form->{acc_trans}{$key}->[$i-1]->{accno}--$form->{acc_trans}{$key}->[$i-1]->{description}"; $amount = $form->{acc_trans}{$key}->[$i-1]->{amount} * $ml; $form->{"${akey}_$form->{acc_trans}{$key}->[$i-1]->{accno}"} += $amount; } } else { $form->{"${akey}_$i"} = $form->{acc_trans}{$key}->[$i-1]->{amount} * $ml; if ($akey eq 'amount') { $form->{"description_$i"} = $form->{acc_trans}{$key}->[$i-1]->{memo}; $form->{rowcount}++; $netamount += $form->{"${akey}_$i"}; $form->{"projectnumber_$i"} = "$form->{acc_trans}{$key}->[$i-1]->{projectnumber}--$form->{acc_trans}{$key}->[$i-1]->{project_id}" if $form->{acc_trans}{$key}->[$i-1]->{project_id}; } $form->{"${key}_$i"} = "$form->{acc_trans}{$key}->[$i-1]->{accno}--$form->{acc_trans}{$key}->[$i-1]->{description}"; } } } } if ($form->{paidaccounts}) { $i = $form->{paidaccounts} + 1; } else { $i = $form->{paidaccounts} = 1; } $form->{"$form->{ARAP}_paid_$i"} = $form->{payment_accno} if $form->{payment_accno}; $form->{"paymentmethod_$i"} = $form->{payment_method} if $form->{payment_method}; $tax = $form->{oldinvtotal} - $netamount; @taxaccounts = split / /, $form->{taxaccounts}; if ($form->{taxincluded}) { $diff = 0; # add tax to individual amounts for $i (1 .. $form->{rowcount}) { if ($netamount) { $amount = $form->{"amount_$i"} * (1 + $tax / $netamount); $form->{"amount_$i"} = $form->round_amount($amount, $form->{precision}); } } } if ($form->{type} =~ /_note/) { $form->{"select$form->{ARAP}_discount"} = ""; } else { $form->{cd_available} = ($form->{taxincluded}) ? ($netamount + $tax) * $form->{cashdiscount} : $netamount * $form->{cashdiscount}; } $form->{invtotal} = $netamount + $tax; if ($form->{id}) { $cdt = ($form->{cdt}) ? ($netamount - $form->{discount_paid}) : $netamount; for (@taxaccounts) { $tax = $form->round_amount($cdt * $form->{"${_}_rate"}, $form->{precision}); if ($tax) { if ($form->{"tax_$_"} == $tax) { $form->{"calctax_$_"} = 1; } } } } else { for (@taxaccounts) { $form->{"calctax_$_"} = 1 } } for (qw(payment discount)) { $form->{"${_}_accno"} = $form->escape($form->{"${_}_accno"},1) } $form->{payment_method} = $form->escape($form->{payment_method}, 1); $form->{cashdiscount} *= 100; $form->{rowcount}++ if ($form->{id} || !$form->{rowcount}); $form->{$form->{ARAP}} ||= $form->{"$form->{ARAP}_1"}; $form->{rowcount} = 1 unless $form->{"$form->{ARAP}_amount_1"}; $form->{locked} = ($form->{revtrans}) ? '1' : ($form->datetonum(\%myconfig, $form->{transdate}) <= $form->{closedto}); # readonly if (! $form->{readonly}) { if ($form->{batch}) { $form->{readonly} = 1 if $myconfig{acs} =~ /Vouchers--Payable Batch/ || $form->{approved}; } else { $form->{readonly} = 1 if $myconfig{acs} =~ /$form->{ARAP}--(Add Transaction| Note)/; } } } sub form_header { $form->{taxincluded} = ($form->{taxincluded}) ? "checked" : ""; # format amounts $form->{exchangerate} = $form->format_amount(\%myconfig, $form->{exchangerate}); if ($form->{defaultcurrency}) { $exchangerate = qq||; $exchangerate .= qq| |.$locale->text('Currency').qq| |; if ($form->{currency} ne $form->{defaultcurrency}) { $fdm = $form->dayofmonth($myconfig{dateformat}, $form->{transdate}, 'fdm'); $ldm = $form->dayofmonth($myconfig{dateformat}, $form->{transdate}); $exchangerate .= qq| |; } $exchangerate .= qq|
|.$locale->text('Exchange Rate').qq| * {exchangerate}> {currency}&login=$form->{login}&path=$form->{path} target=_blank>?
|; } $taxincluded = ""; if ($form->{taxaccounts}) { $taxincluded = qq| {taxincluded}> |.$locale->text('Tax Included').qq| |; } if (($rows = $form->numtextrows($form->{notes}, 50) - 1) < 2) { $rows = 2; } $notes = qq||; if (($rows = $form->numtextrows($form->{intnotes}, 50) - 1) < 2) { $rows = 2; } $intnotes = qq||; $department = qq| |.$locale->text('Department').qq| | if $form->{selectdepartment}; $n = ($form->{creditremaining} < 0) ? "0" : "1"; if ($form->{vc} eq 'customer') { $vclabel = $locale->text('Customer'); $vcnumber = $locale->text('Customer Number'); } else { $vclabel = $locale->text('Vendor'); $vcnumber = $locale->text('Vendor Number'); } $vcref = qq|{vc}&id=$form->{"$form->{vc}_id"}&login=$form->{login}&path=$form->{path} target=_blank>?|; $vc = qq| $vclabel * |; if ($form->{"select$form->{vc}"}) { $vc .= qq| $vcref $vcnumber $form->{"$form->{vc}number"} | . $form->hide_form("$form->{vc}number"); } else { $vc .= qq| $vcref $vcnumber {vc}number"}" size=35> |; } $employee = $form->hide_form(qw(employee)); if ($form->{selectemployee}) { $label = ($form->{ARAP} eq 'AR') ? $locale->text('Salesperson') : $locale->text('Employee'); $employee = qq| $label |; } for (qw(terms discountterms)) { $form->{$_} = "" if ! $form->{$_} } $focus = ($form->{focus}) ? $form->{focus} : "amount_$form->{rowcount}"; if ($form->{"select$form->{ARAP}_discount"}) { $terms = qq| |.$locale->text('Terms').qq| format_amount(\%myconfig, $form->{cashdiscount}).qq|> / {discountterms}> |.$locale->text('Net').qq| {terms}> |.$locale->text('days').qq| |; } else { $terms = qq| |.$locale->text('Terms').qq| |.$locale->text('Net').qq| {terms}> |.$locale->text('days').qq| |; } if ($form->{batch} && ! $form->{approved}) { $transdate = qq| $form->{transdate} {transdate}> |; } else { $transdate = qq| {transdate}> |; } if ($form->{vc} eq 'vendor') { $dcn = qq| |.$locale->text('DCN').qq| |; } else { $dcn = qq| |.$locale->text('DCN').qq| $form->{dcn} | .$form->hide_form('dcn'); } if (($rows = $form->numtextrows($form->{description}, 60, 5)) > 1) { $description = qq||; } else { $description = qq||; } $description = qq| |.$locale->text('Description').qq| $description |; $reference_documents = &reference_documents; $form->{onhold} = ($form->{onhold}) ? "checked" : ""; $form->header; print qq|
{script}> |; $form->hide_form(qw(id type printed emailed sort closedto locked oldtransdate oldduedate oldcurrency audittrail recurring checktax creditlimit creditremaining defaultcurrency rowcount oldterms batch batchid batchnumber batchdescription cdt precision remittancevoucher reference_rows referenceurl)); $form->hide_form("select$form->{vc}"); $form->hide_form(map { "select$_" } qw(formname currency department employee projectnumber language paymentmethod printer)); $form->hide_form("old$form->{vc}", "$form->{vc}_id", "old$form->{vc}number"); $form->hide_form(map { "select$_" } ("$form->{ARAP}_amount", "$form->{ARAP}", "$form->{ARAP}_paid", "$form->{ARAP}_discount")); print qq| |; } else { $vc = qq| |; } # departments if (@{ $form->{all_department} }) { $form->{selectdepartment} = "\n"; for (@{ $form->{all_department} }) { $form->{selectdepartment} .= qq|$_->{description}--$_->{id}\n| } $l_department = qq| |.$locale->text('Department'); $department = qq| |; } if (@{ $form->{all_warehouse} }) { $form->{selectwarehouse} = "\n"; $form->{warehouse} = qq|$form->{warehouse}--$form->{warehouse_id}|; for (@{ $form->{all_warehouse} }) { $form->{selectwarehouse} .= qq|$_->{description}--$_->{id}\n| } $warehouse = qq| |; $l_warehouse = qq| |.$locale->text('Warehouse'); } if (@{ $form->{all_employee} }) { $form->{selectemployee} = "\n"; for (@{ $form->{all_employee} }) { $form->{selectemployee} .= qq|$_->{name}--$_->{id}\n| } $employeelabel = ($form->{ARAP} eq 'AR') ? $locale->text('Salesperson') : $locale->text('Employee'); $employee = qq| |; $l_employee = qq| $employeelabel|; } if ($form->{ARAP} eq 'AR') { $form->{title} = $locale->text('AR Transactions'); $form->helpref("ar_transactions", $myconfig{countrycode}); } else { $form->{title} = $locale->text('AP Transactions'); $form->helpref("ap_transactions", $myconfig{countrycode}); } $invnumber = qq| |; $openclosed = qq| |; $summary = qq| |; if ($form->{outstanding}) { if ($form->{ARAP} eq 'AR') { $form->{title} = $locale->text('AR Outstanding'); $form->helpref("ar_outstanding", $myconfig{countrycode}); } else { $form->{title} = $locale->text('AP Outstanding'); $form->helpref("ap_outstanding", $myconfig{countrycode}); } $invnumber = ""; $openclosed = ""; $summary = ""; } if (@{ $form->{all_years} }) { # accounting years $selectaccountingyear = "\n"; for (@{ $form->{all_years} }) { $selectaccountingyear .= qq|$_\n| } $selectaccountingmonth = "\n"; for (sort keys %{ $form->{all_month} }) { $selectaccountingmonth .= qq|$_--|.$locale->text($form->{all_month}{$_}).qq|\n| } $selectfrom = qq| |; } @f = (); push @f, qq| |.$locale->text('No.'); push @f, qq| |.$locale->text('ID'); push @f, qq| |.$locale->text('Invoice Number'); push @f, qq| |.$locale->text('Order Number'); push @f, qq| |.$locale->text('Description'); push @f, qq| |.$locale->text('PO Number'); push @f, qq| |.$locale->text('Invoice Date'); push @f, $l_name; push @f, $l_customernumber if $l_customernumber; push @f, $l_vendornumber if $l_vendornumber; push @f, qq| |.$locale->text('Address'); push @f, $l_employee if $l_employee; push @f, $l_department if $l_department; push @f, qq| |.$locale->text('Amount'); push @f, qq| |.$locale->text('Tax'); push @f, qq| |.$locale->text('Total'); push @f, qq| |.$locale->text('Currency'); push @f, qq| |.$locale->text('Date Paid'); push @f, qq| |.$locale->text('Payment Difference'); push @f, qq| |.$locale->text('Paid'); push @f, qq| |.$locale->text('Payment Method'); push @f, qq| |.$locale->text('Due Date'); push @f, qq| |.$locale->text('Due'); push @f, qq| |.$locale->text('Line Item'); push @f, qq| |.$locale->text('Notes'); push @f, $l_till if $l_till; push @f, $l_warehouse if $l_warehouse; push @f, qq| |.$locale->text('Shipping Point'); push @f, qq| |.$locale->text('Ship via'); push @f, qq| |.$locale->text('Waybill'); push @f, qq| |.$locale->text('DCN'); $form->header; print qq| {script}>
$form->{helpref}$form->{title}
$vc $exchangerate $taxincluded
|.$locale->text('Address').qq| $form->{address1} $form->{address2} $form->{city} $form->{state} $form->{zipcode} $form->{country}
|.$locale->text('Credit Limit').qq|
|.$form->format_amount(\%myconfig, $form->{creditlimit}, 0, "0").qq| |.$locale->text('Remaining').qq| |.$form->format_amount(\%myconfig, $form->{creditremaining}, 0, "0").qq|
 
{onhold}> |.$locale->text('On Hold').qq|
$department $employee $transdate $terms
|.$locale->text('Invoice Number').qq|
|.$locale->text('Order Number').qq|
|.$locale->text('Invoice Date').qq| *
|.$locale->text('Due Date').qq| {duedate}>
|.$locale->text('PO Number').qq|
$dcn $description
$reference_documents
|; if ($form->{selectprojectnumber}) { $project = qq| |; } print qq| $project |; $form->{subtotal} = 0; for $i (1 .. $form->{rowcount}) { if ($form->{selectprojectnumber}) { $project = qq| |; } if (($rows = $form->numtextrows($form->{"description_$i"}, 40)) > 1) { $description = qq||; } else { $description = qq||; } $form->{subtotal} += $form->{"amount_$i"}; print qq| $description $project |; } foreach $item (split / /, $form->{taxaccounts}) { $form->{"calctax_$item"} = ($form->{"calctax_$item"}) ? "checked" : ""; $form->{"tax_$item"} = $form->format_amount(\%myconfig, $form->{"tax_$item"}, $form->{precision}); print qq| |; $form->hide_form(map { "${item}_$_" } qw(rate description taxnumber)); $form->hide_form("select$form->{ARAP}_tax_$item"); } if (!$form->{"$form->{ARAP}_discount_paid"}) { $form->{"$form->{ARAP}_discount_paid"} = $form->unescape($form->{discount_accno}); } if ($form->{currency} eq $form->{defaultcurrency}) { @column_index = qw(datepaid source memo paid); } else { @column_index = qw(datepaid source memo paid exchangerate); } push @column_index, "paymentmethod" if $form->{selectpaymentmethod}; push @column_index, "ARAP_paid"; $column_data{datepaid} = ""; $column_data{paid} = ""; $column_data{exchangerate} = ""; $column_data{ARAP_paid} = ""; $column_data{source} = ""; $column_data{memo} = ""; $column_data{paymentmethod} = ""; $total = ""; $cashdiscount = ""; $payments = ""; $totalpaid = 0; if ($form->{cashdiscount}) { $discountavailable = qq| |; $cashdiscount = qq|
|.$locale->text('Project').qq|
|.$locale->text('Amount').qq| |.$locale->text('Account').qq| |.$locale->text('Description').qq|
{precision}) .qq|" accesskey="$i">
{"tax_$item"}> {"calctax_$item"}>
".$locale->text('Date')."".$locale->text('Amount')."".$locale->text('Exch')."".$locale->text('Account')."".$locale->text('Source')."".$locale->text('Memo')."".$locale->text('Method')."
|.$locale->text('Cash Discount').qq|: |.$form->format_amount(\%myconfig, $form->{cd_available}, $form->{precision}).qq|
|.$locale->text('Cash Discount').qq|
|; for (@column_index) { $cashdiscount .= qq|$column_data{$_}\n| } $totalpaid = $form->{"discount_paid"}; $cashdiscount .= qq| |; $exchangerate = qq| |; if ($form->{currency} ne $form->{defaultcurrency}) { $form->{discount_exchangerate} = $form->format_amount(\%myconfig, $form->{discount_exchangerate}); $exchangerate = qq|{"discount_exchangerate"}>|.$form->hide_form(qw(olddiscount_datepaid)); } $column_data{paid} = qq||; $column_data{ARAP_paid} = qq||; $column_data{datepaid} = qq||; $column_data{exchangerate} = qq||; $column_data{source} = qq||; $column_data{memo} = qq||; if ($form->{selectpaymentmethod}) { $column_data{paymentmethod} = qq||; } $cashdiscount .= qq| |; for (@column_index) { $cashdiscount .= qq|$column_data{$_}\n| } $cashdiscount .= qq| |; $cashdiscount .= $form->hide_form(map { "discount_$_" } qw(cleared)); $payments = qq| |; } else { $payments = qq| $discountavailable $cashdiscount $payments |; $form->{paidaccounts}++ if ($form->{"paid_$form->{paidaccounts}"}); $form->{"$form->{ARAP}_paid_$form->{paidaccounts}"} = $form->unescape($form->{payment_accno}); $form->{"paymentmethod_$form->{paidaccounts}"} = $form->unescape($form->{payment_method}); $roundto = 0; if ($form->{roundchange}) { %roundchange = split /[=;]/, $form->unescape($form->{roundchange}); $roundto = $roundchange{''}; } $totalpaid = 0; for $i (1 .. $form->{paidaccounts}) { print qq| |; $form->{"exchangerate_$i"} = $form->format_amount(\%myconfig, $form->{"exchangerate_$i"}); $exchangerate = qq| |; if ($form->{currency} ne $form->{defaultcurrency}) { $exchangerate = qq|{"exchangerate_$i"}>|.$form->hide_form("olddatepaid_$i"); } $form->hide_form(map { "${_}_$i" } qw(vr_id cleared)); $totalpaid += $form->{"paid_$i"}; $column_data{paid} = qq||; $column_data{ARAP_paid} = qq||; $column_data{exchangerate} = qq||; $column_data{datepaid} = qq||; $column_data{source} = qq||; $column_data{memo} = qq||; if ($form->{selectpaymentmethod}) { if ($form->{"paymentmethod_$i"}) { if ($form->{"paid_$i"}) { $roundto = $roundchange{$form->{"paymentmethod_$i"}}; } } $column_data{paymentmethod} = qq||; } for (@column_index) { print qq|$column_data{$_}\n| } print " "; } $totalpaid = $form->round_amount($totalpaid, $form->{precision}); if ($totalpaid == 0) { $roundto = $roundchange{$form->{"paymentmethod_$form->{paidaccounts}"}}; } if ($roundto > 0.01) { $outstanding = $form->round_amount($form->{oldinvtotal} / $roundto, 0) * $roundto; $outstanding -= $totalpaid; $outstanding = $form->round_amount($outstanding / $roundto, 0) * $roundto; } else { $outstanding = $form->round_amount($form->{oldinvtotal} - $totalpaid, $form->{precision}); } if ($outstanding) { # print total if ($outstanding > 0) { print qq| |; } else { print qq| |; } } $form->hide_form(qw(address1 address2 city state zipcode country paidaccounts payment_accno discount_accno payment_method roundchange cashovershort)); print qq|
format_amount(\%myconfig, $form->{"discount_paid"}, $form->{precision}).qq|>{"discount_datepaid"}>$exchangerate
|.$locale->text('Payments').qq|
|.$locale->text('Payments').qq|
|; for (@column_index) { $payments .= qq|$column_data{$_}\n| } $payments .= qq| |; } if ($form->{batch}) { $cashdiscount = ""; $payments = ""; $form->{paidaccounts} = 0; } $cd_tax = 0; if ($form->{discount_paid} && $form->{cdt}) { $cdtp = $form->{discount_paid} / $form->{subtotal} if $form->{subtotal}; for (split / /, $form->{taxaccounts}) { $cd_tax += $form->round_amount($form->{"tax_$_"} * $cdtp, $form->{precision}); } } $form->{subtotal} = $form->format_amount(\%myconfig, $form->{subtotal} - $form->{discount_paid}, $form->{precision}); $form->{invtotal} = $form->format_amount(\%myconfig, $form->{invtotal}, $form->{precision}); $form->hide_form(qw(oldinvtotal oldtotalpaid taxaccounts)); print qq|
$form->{invtotal}
|.$locale->text('Notes').qq|
$notes		 |.$locale->text('Internal Notes').qq|
$intnotes
format_amount(\%myconfig, $form->{"paid_$i"}, $form->{precision}).qq|>$exchangerate{"datepaid_$i"}>
|.$locale->text('Outstanding').": ".$form->format_amount(\%myconfig, $outstanding, $form->{precision}).qq|
|.$locale->text('Overpaid').": ".$form->format_amount(\%myconfig, $outstanding * -1, $form->{precision}).qq|
|; } sub form_footer { $form->hide_form(qw(helpref callback path login)); $transdate = $form->datetonum(\%myconfig, $form->{transdate}); if ($form->{readonly}) { &islocked; } else { &print_options; print "
"; %button = ('Update' => { ndx => 1, key => 'U', value => $locale->text('Update') }, 'Preview' => { ndx => 3, key => 'V', value => $locale->text('Preview') }, 'Print' => { ndx => 4, key => 'P', value => $locale->text('Print') }, 'Post' => { ndx => 5, key => 'O', value => $locale->text('Post') }, 'Print and Post' => { ndx => 6, key => 'R', value => $locale->text('Print and Post') }, 'Post as new' => { ndx => 7, key => 'N', value => $locale->text('Post as new') }, 'Print and Post as new' => { ndx => 8, key => 'W', value => $locale->text('Print and Post as new') }, 'Schedule' => { ndx => 9, key => 'H', value => $locale->text('Schedule') }, 'New Number' => { ndx => 10, key => 'M', value => $locale->text('New Number') }, 'Delete' => { ndx => 11, key => 'D', value => $locale->text('Delete') }, ); delete $button{'Schedule'} if $form->{batch}; if ($form->{id}) { if ($form->{locked} || $transdate <= $form->{closedto}) { for ("Post", "Print and Post", "Delete") { delete $button{$_} } } } else { for ("Post as new", "Print and Post as new", "Delete") { delete $button{$_} } if ($transdate <= $form->{closedto}) { for ("Post", "Print and Post") { delete $button{$_} } } } if (!$latex) { for ("Preview", "Print and Post", "Print and Post as new") { delete $button{$_} } } for (sort { $button{$a}->{ndx} <=> $button{$b}->{ndx} } keys %button) { $form->print_button(\%button, $_) } } if ($form->{menubar}) { require "$form->{path}/menu.pl"; &menubar; } print qq| |; } sub update { my $display = shift; if (!$display) { $form->{invtotal} = 0; $form->{exchangerate} = $form->parse_amount(\%myconfig, $form->{exchangerate}); @flds = (qw(referencedescription referenceid)); $count = 0; @f = (); for $i (1 .. $form->{reference_rows}) { if ($form->{"referenceid_$i"}) { push @f, {}; $j = $#f; for (@flds) { $f[$j]->{$_} = $form->{"${_}_$i"} } $count++; } } $form->redo_rows(\@flds, \@f, $count, $form->{reference_rows}); $form->{reference_rows} = $count + 1; @flds = ("amount", "$form->{ARAP}_amount", "projectnumber", "description"); $count = 0; @f = (); for $i (1 .. $form->{rowcount}) { $form->{"amount_$i"} = $form->parse_amount(\%myconfig, $form->{"amount_$i"}); if ($form->{"amount_$i"}) { push @f, {}; $j = $#f; for (@flds) { $f[$j]->{$_} = $form->{"${_}_$i"} } $count++; } } $form->redo_rows(\@flds, \@f, $count, $form->{rowcount}); $form->{rowcount} = $count + 1; $form->{"$form->{ARAP}_amount_$form->{rowcount}"} = $form->{"$form->{ARAP}_amount_$count"}; for (1 .. $form->{rowcount}) { $form->{invtotal} += $form->{"amount_$_"} } if ($form->{transdate} ne $form->{oldtransdate} || $form->{currency} ne $form->{oldcurrency}) { $form->{exchangerate} = $form->check_exchangerate(\%myconfig, $form->{currency}, $form->{transdate}); } $form->{cashdiscount} = $form->parse_amount(\%myconfig, $form->{cashdiscount}); $form->{discount_paid} = $form->parse_amount(\%myconfig, $form->{discount_paid}); if ($newname = &check_name($form->{vc})) { &rebuild_vc($form->{vc}, $form->{ARAP}, $form->{transdate}); } if ($form->{oldterms} != $form->{terms}) { $form->{duedate} = $form->add_date(\%myconfig, $form->{transdate}, $form->{terms}, 'days'); $newterms = 1; $form->{oldterms} = $form->{terms}; $form->{oldduedate} = $form->{duedate}; } if ($form->{duedate} ne $form->{oldduedate}) { $form->{terms} = $form->datediff(\%myconfig, $form->{transdate}, $form->{duedate}); $newterms = 1; $form->{oldterms} = $form->{terms}; $form->{oldduedate} = $form->{duedate}; } if ($form->{transdate} ne $form->{oldtransdate}) { $form->{duedate} = $form->add_date(\%myconfig, $form->{transdate}, $form->{terms}, 'days') if ! $newterms; $form->{oldtransdate} = $form->{transdate}; $newproj = &rebuild_vc($form->{vc}, $form->{ARAP}, $form->{transdate}) if ! $newname; if (! $newproj) { $form->all_projects(\%myconfig, undef, $form->{transdate}); $form->{selectprojectnumber} = ""; if (@{ $form->{all_project} }) { $form->{selectprojectnumber} = "\n"; for (@{ $form->{all_project} }) { $form->{selectprojectnumber} .= qq|$_->{projectnumber}--$_->{id}\n| } $form->{selectprojectnumber} = $form->escape($form->{selectprojectnumber},1); } } if (@{ $form->{all_employee} }) { $form->{selectemployee} = "\n"; for (@{ $form->{all_employee} }) { $form->{selectemployee} .= qq|$_->{name}--$_->{id}\n| } $form->{selectemployee} = $form->escape($form->{selectemployee},1); } } } # recalculate taxes @taxaccounts = split / /, $form->{taxaccounts}; for (@taxaccounts) { $form->{"tax_$_"} = $form->parse_amount(\%myconfig, $form->{"tax_$_"}) } if ($form->{taxincluded}) { $ml = 1; for (0 .. 1) { $taxrate = 0; $diff = 0; for (@taxaccounts) { if (($form->{"${_}_rate"} * $ml) > 0) { if ($form->{"calctax_$_"}) { $taxrate += $form->{"${_}_rate"}; } else { if ($form->{checktax}) { if ($form->{"tax_$_"}) { $taxrate += $form->{"${_}_rate"}; } } } } } $taxrate *= $ml; foreach $item (@taxaccounts) { if (($form->{"${item}_rate"} * $ml) > 0) { if ($taxrate) { $x = ($form->{cdt}) ? ($form->{invtotal} - $form->{discount_paid}) : $form->{invtotal}; $x *= $form->{"${item}_rate"} / (1 + $taxrate); $y = $form->round_amount($x, $form->{precision}); $tax = $form->round_amount($x - $diff, $form->{precision}); $diff = $y - ($x - $diff); } $form->{"tax_$item"} = $tax if $form->{"calctax_$item"}; $form->{"select$form->{ARAP}_tax_$item"} = qq|$item--$form->{"${item}_description"}|; $totaltax += $form->{"tax_$item"}; } } $ml *= -1; } $totaltax += $form->round_amount($diff, $form->{precision}); $form->{checktax} = 1; } else { foreach $item (@taxaccounts) { $form->{"calctax_$item"} = 1 if $form->{calctax}; if ($form->{"calctax_$item"}) { $x = ($form->{cdt}) ? $form->{invtotal} - $form->{discount_paid} : $form->{invtotal}; $form->{"tax_$item"} = $form->round_amount($x * $form->{"${item}_rate"}, $form->{precision}); } $form->{"select$form->{ARAP}_tax_$item"} = qq|$item--$form->{"${item}_description"}|; $totaltax += $form->{"tax_$item"}; } } # redo payment discount $form->{cd_available} = $form->{invtotal} * $form->{cashdiscount} / 100; if ($form->{taxincluded}) { $netamount = $form->{invtotal} - $totaltax; } else { $netamount = $form->{invtotal}; $form->{invtotal} += $totaltax; } if ($form->{discount_paid}) { if ($form->{discount_datepaid} ne $form->{olddiscount_datepaid} || $form->{currency} ne $form->{oldcurrency}) { if ($exchangerate = $form->check_exchangerate(\%myconfig, $form->{currency}, $form->{discount_datepaid})) { $form->{discount_exchangerate} = $exchangerate; } } $form->{olddiscount_datepaid} = $form->{discount_datepaid}; } $form->{oldcurrency} = $form->{currency}; $totalpaid = $form->{discount_paid}; $j = 1; for $i (1 .. $form->{paidaccounts}) { if ($form->{"paid_$i"}) { for (qw(olddatepaid datepaid source memo cleared paymentmethod)) { $form->{"${_}_$j"} = $form->{"${_}_$i"} } for (qw(paid exchangerate)) { $form->{"${_}_$j"} = $form->parse_amount(\%myconfig, $form->{"${_}_$i"}) } $totalpaid += $form->{"paid_$j"}; if ($form->{"datepaid_$j"} ne $form->{"olddatepaid_$j"} || $form->{currency} ne $form->{oldcurrency}) { if ($exchangerate = $form->check_exchangerate(\%myconfig, $form->{currency}, $form->{"datepaid_$j"})) { $form->{"exchangerate_$j"} = $exchangerate; } } $form->{"olddatepaid_$j"} = $form->{"datepaid_$j"}; if ($j++ != $i) { for (qw(olddatepaid datepaid source memo paid exchangerate cleared)) { delete $form->{"${_}_$i"} } } } else { for (qw(olddatepaid datepaid source memo paid exchangerate cleared)) { delete $form->{"${_}_$i"} } } } $form->{payment_accno} = $form->escape($form->{"$form->{ARAP}_paid_$form->{paidaccounts}"},1); $form->{payment_method} = $form->escape($form->{"paymentmethod_$form->{paidaccounts}"},1); $form->{paidaccounts} = $j; $ml = ($form->{type} =~ /_note/) ? -1 : 1; $form->{creditremaining} -= ($form->{invtotal} - $totalpaid + $form->{oldtotalpaid} - $form->{oldinvtotal}) * $ml; $form->{oldinvtotal} = $form->{invtotal}; $form->{oldtotalpaid} = $totalpaid; &display_form; } sub post { $label = ($form->{vc} eq 'customer') ? $locale->text('Customer missing!') : $locale->text('Vendor missing!'); # check if there is an invoice number, invoice and due date $form->isblank("transdate", $locale->text('Invoice Date missing!')); $form->isblank($form->{vc}, $label); $transdate = $form->datetonum(\%myconfig, $form->{transdate}); $form->error($locale->text('Cannot post transaction for a closed period!')) if ($transdate <= $form->{closedto}); $form->isblank("exchangerate", $locale->text('Exchange rate missing!')) if ($form->{currency} ne $form->{defaultcurrency}); $roundto = 0; if ($form->{roundchange}) { %roundchange = split /[=;]/, $form->unescape($form->{roundchange}); $roundto = $roundchange{''}; } $paid = 0; for $i (1 .. $form->{paidaccounts}) { if ($form->{"paid_$i"}) { $paid += $form->parse_amount(\%myconfig, $form->{"paid_$i"}); $datepaid = $form->datetonum(\%myconfig, $form->{"datepaid_$i"}); $form->isblank("datepaid_$i", $locale->text('Payment date missing!')); $form->error($locale->text('Cannot post payment for a closed period!')) if ($datepaid <= $form->{closedto}); if ($form->{currency} ne $form->{defaultcurrency}) { $form->{"exchangerate_$i"} = $form->{exchangerate} if ($transdate == $datepaid); $form->isblank("exchangerate_$i", $locale->text('Exchange rate for payment missing!')); } if ($form->{selectpaymentmethod}) { $roundto = $roundchange{$form->{"paymentmethod_$i"}}; } } } $ARAP_paid = $form->{"$form->{ARAP}_paid_$form->{paidaccounts}"}; $paymentmethod = $form->{"paymentmethod_$form->{paidaccounts}"}; # if oldname ne name redo form ($name) = split /--/, $form->{$form->{vc}}; if ($form->{"old$form->{vc}"} ne qq|$name--$form->{"$form->{vc}_id"}|) { &update; exit; } if (! $form->{repost}) { if ($form->{id} && ! $form->{batch}) { &repost; exit; } } # add discount to payments if ($form->{discount_paid}) { $form->{paidaccounts}++ if $form->{"paid_$form->{paidaccounts}"}; $i = $form->{paidaccounts}; for (qw(paid datepaid source memo exchangerate cleared)) { $form->{"${_}_$i"} = $form->{"discount_$_"} } $form->{discount_index} = $i; $form->{"$form->{ARAP}_paid_$i"} = $form->{"$form->{ARAP}_discount_paid"}; $form->{"paymentmethod_$i"} = $form->{discount_paymentmethod}; if ($form->{"paid_$i"}) { $paid += $form->parse_amount(\%myconfig, $form->{"paid_$i"}); $datepaid = $form->datetonum(\%myconfig, $form->{"datepaid_$i"}); $expired = $form->datetonum(\%myconfig, $form->add_date(\%myconfig, $form->{transdate}, $form->{discountterms}, 'days')); $form->isblank("datepaid_$i", $locale->text('Cash Discount date missing!')); $form->error($locale->text('Cannot post cash discount for a closed period!')) if ($datepaid <= $form->{closedto}); $form->error($locale->text('Date for cash discount past due!')) if ($datepaid > $expired); $form->error($locale->text('Cash discount exceeds available discount!')) if $form->parse_amount(\%myconfig, $form->{"paid_$i"}) > ($form->{oldinvtotal} * $form->{cashdiscount}); if ($form->{currency} ne $form->{defaultcurrency}) { $form->{"exchangerate_$i"} = $form->{exchangerate} if ($transdate == $datepaid); $form->isblank("exchangerate_$i", $locale->text('Exchange rate for cash discount missing!')); } } } if ($roundto > 0.01) { $total = $form->round_amount($form->{oldinvtotal} / $roundto, 0) * $roundto; $cashover = $form->round_amount($paid - $total - ($paid - $form->{oldinvtotal}), $form->{precision}); if ($cashover) { if ($form->round_amount($paid, $form->{precision}) == $form->round_amount($total, $form->{precision})) { $i = ++$form->{paidaccounts}; $form->{"paid_$i"} = $form->format_amount(\%myconfig, $cashover, $form->{precision}); $form->{"datepaid_$i"} = $datepaid; $form->{"$form->{ARAP}_paid_$i"} = $form->{cashovershort}; } } } $i = ++$form->{paidaccounts}; $form->{"$form->{ARAP}_paid_$i"} = $ARAP_paid; $form->{"paymentmethod_$i"} = $paymentmethod; if ($form->{batch}) { $rc = VR->post_transaction(\%myconfig, \%$form); } else { $rc = AA->post_transaction(\%myconfig, \%$form); } if ($form->{callback}) { $form->{callback} =~ s/(batch|batchid|batchdescription)=.*?&//g; $form->{callback} .= "&batch=$form->{batch}&batchid=$form->{batchid}&transdate=$form->{transdate}&batchdescription=".$form->escape($form->{batchdescription},1); } if ($rc) { $form->redirect($locale->text('Transaction posted!')); } else { $form->error($locale->text('Cannot post transaction!')); } } sub delete { $form->{title} = $locale->text('Confirm!'); $form->header; print qq|
{script}> |; $form->{action} = "yes"; $form->hide_form; print qq|

$form->{title}

|.$locale->text('Are you sure you want to delete Transaction').qq| $form->{invnumber}

|; } sub yes { if (AA->delete_transaction(\%myconfig, \%$form)) { $form->redirect($locale->text('Transaction deleted!')); } else { $form->error($locale->text('Cannot delete transaction!')); } } sub search { $form->create_links($form->{ARAP}, \%myconfig, $form->{vc}); $form->{"select$form->{ARAP}"} = "\n"; for (@{ $form->{"$form->{ARAP}_links"}{$form->{ARAP}} }) { $form->{"select$form->{ARAP}"} .= "$_->{accno}--$_->{description}\n" } $vclabel = $locale->text('Customer'); $vcnumber = $locale->text('Customer Number'); $l_name = qq| $vclabel|; $l_customernumber = qq| $vcnumber|; $l_till = qq| |.$locale->text('Till'); if ($form->{vc} eq 'vendor') { $vclabel = $locale->text('Vendor'); $vcnumber = $locale->text('Vendor Number'); $l_till = ""; $l_customernumber = ""; $l_name = qq| $vclabel|; $l_vendornumber = qq| $vcnumber|; } if (@{ $form->{"all_$form->{vc}"} }) { $form->{"select$form->{vc}"} = "\n"; for (@{ $form->{"all_$form->{vc}"} }) { $form->{"select$form->{vc}"} .= qq|$_->{name}--$_->{id}\n| } $vc = qq|
$vclabel
$vclabel {vc} size=35>
$vcnumber
|.$locale->text('Department').qq|
|.$locale->text('Warehouse').qq|
$employeelabel
|.$locale->text('Invoice Number').qq|
|.$locale->text('Description').qq|
|.$locale->text('Order Number').qq|
|.$locale->text('PO Number').qq|
|.$locale->text('Source').qq|
|.$locale->text('Line Item').qq|
|.$locale->text('Notes').qq|
|.$locale->text('Open').qq| |.$locale->text('Closed').qq| |.$locale->text('On Hold').qq| |.$locale->text('Paid Late').qq| |.$locale->text('Paid Early').qq|
|.$locale->text('Summary').qq| |.$locale->text('Detail').qq|
|.$locale->text('Period').qq|
 |.$locale->text('Current').qq|  |.$locale->text('Month').qq|  |.$locale->text('Quarter').qq|  |.$locale->text('Year').qq|
$form->{helpref}$form->{title}
$vc $invnumber $selectfrom
|.$locale->text('Account').qq|
|.$locale->text('From').qq| |.$locale->text('To').qq|
$employee $department $warehouse
|.$locale->text('Shipping Point').qq|
|.$locale->text('Ship via').qq|
|.$locale->text('Waybill').qq|
|.$locale->text('Include in Report').qq| $openclosed $summary |; $form->{sort} = "transdate"; $form->hide_form(qw(title outstanding sort helpref)); while (@f) { print qq|\n|; for (1 .. 5) { print qq|\n|; } print qq|\n|; } print qq|
|. shift @f; print qq|
|.$locale->text('Subtotal').qq|

|; $form->hide_form(qw(nextsub path login)); print qq| |; if ($form->{menubar}) { require "$form->{path}/menu.pl"; &menubar; } print qq| |; } sub transactions { if ($form->{$form->{vc}}) { ($form->{$form->{vc}}, $form->{"$form->{vc}_id"}) = split(/--/, $form->{$form->{vc}}); } AA->transactions(\%myconfig, \%$form); $href = "$form->{script}?action=transactions"; for (qw(direction oldsort till outstanding path login summary)) { $href .= qq|&$_=$form->{$_}| } $href .= "&title=".$form->escape($form->{title}); $href .= "&helpref=".$form->escape($form->{helpref}); $form->sort_order(); $callback = "$form->{script}?action=transactions"; for (qw(direction oldsort till outstanding path login summary)) { $callback .= qq|&$_=$form->{$_}| } $callback .= "&title=".$form->escape($form->{title},1); $callback .= "&helpref=".$form->escape($form->{helpref},1); if ($form->{$form->{ARAP}}) { $callback .= "&$form->{ARAP}=".$form->escape($form->{$form->{ARAP}},1); $href .= "&$form->{ARAP}=".$form->escape($form->{$form->{ARAP}}); $form->{$form->{ARAP}} =~ s/--/ /; $option = $locale->text('Account')." : $form->{$form->{ARAP}}"; } if ($form->{$form->{vc}}) { $callback .= "&$form->{vc}=".$form->escape($form->{$form->{vc}},1).qq|--$form->{"$form->{vc}_id"}|; $href .= "&$form->{vc}=".$form->escape($form->{$form->{vc}}).qq|--$form->{"$form->{vc}_id"}|; $option .= "\n
" if ($option); $name = ($form->{vc} eq 'customer') ? $locale->text('Customer') : $locale->text('Vendor'); $option .= "$name : $form->{$form->{vc}}"; } if ($form->{"$form->{vc}number"}) { $callback .= "&$form->{vc}number=".$form->escape($form->{"$form->{vc}number"},1); $href .= "&$form->{vc}number=".$form->escape($form->{"$form->{vc}number"}); $option .= "\n
" if ($option); $name = ($form->{vc} eq 'customer') ? $locale->text('Customer Number') : $locale->text('Vendor Number'); $option .= qq|$name : $form->{"$form->{vc}number"}|; } if ($form->{department}) { $callback .= "&department=".$form->escape($form->{department},1); $href .= "&department=".$form->escape($form->{department}); ($department) = split /--/, $form->{department}; $option .= "\n
" if ($option); $option .= $locale->text('Department')." : $department"; } if ($form->{employee}) { $callback .= "&employee=".$form->escape($form->{employee},1); $href .= "&employee=".$form->escape($form->{employee}); ($employee) = split /--/, $form->{employee}; $option .= "\n
" if ($option); if ($form->{ARAP} eq 'AR') { $option .= $locale->text('Salesperson'); } else { $option .= $locale->text('Employee'); } $option .= " : $employee"; } if ($form->{invnumber}) { $callback .= "&invnumber=".$form->escape($form->{invnumber},1); $href .= "&invnumber=".$form->escape($form->{invnumber}); $option .= "\n
" if ($option); $option .= $locale->text('Invoice Number')." : $form->{invnumber}"; } if ($form->{description}) { $callback .= "&description=".$form->escape($form->{description},1); $href .= "&description=".$form->escape($form->{description}); $option .= "\n
" if ($option); $option .= $locale->text('Description')." : $form->{description}"; } if ($form->{ordnumber}) { $callback .= "&ordnumber=".$form->escape($form->{ordnumber},1); $href .= "&ordnumber=".$form->escape($form->{ordnumber}); $option .= "\n
" if ($option); $option .= $locale->text('Order Number')." : $form->{ordnumber}"; } if ($form->{ponumber}) { $callback .= "&ponumber=".$form->escape($form->{ponumber},1); $href .= "&ponumber=".$form->escape($form->{ponumber}); $option .= "\n
" if ($option); $option .= $locale->text('PO Number')." : $form->{ponumber}"; } if ($form->{notes}) { $callback .= "¬es=".$form->escape($form->{notes},1); $href .= "¬es=".$form->escape($form->{notes}); $option .= "\n
" if $option; $option .= $locale->text('Notes')." : $form->{notes}"; } if ($form->{warehouse}) { $callback .= "&warehouse=".$form->escape($form->{warehouse},1); $href .= "&warehouse=".$form->escape($form->{warehouse}); ($warehouse) = split /--/, $form->{warehouse}; $option .= "\n
" if ($option); $option .= $locale->text('Warehouse')." : $warehouse"; delete $form->{l_warehouse}; } if ($form->{shippingpoint}) { $callback .= "&shippingpoint=".$form->escape($form->{shippingpoint},1); $href .= "&shippingpoint=".$form->escape($form->{shippingpoint}); $option .= "\n
" if ($option); $option .= $locale->text('Shipping Point')." : $form->{shippingpoint}"; } if ($form->{shipvia}) { $callback .= "&shipvia=".$form->escape($form->{shipvia},1); $href .= "&shipvia=".$form->escape($form->{shipvia}); $option .= "\n
" if ($option); $option .= $locale->text('Ship via')." : $form->{shipvia}"; } if ($form->{waybill}) { $callback .= "&waybill=".$form->escape($form->{waybill},1); $href .= "&waybill=".$form->escape($form->{waybill}); $option .= "\n
" if ($option); $option .= $locale->text('Waybill')." : $form->{waybill}"; } if ($form->{memo}) { $callback .= "&memo=".$form->escape($form->{memo},1); $href .= "&memo=".$form->escape($form->{memo}); $option .= "\n
" if $option; $option .= $locale->text('Line Item')." : $form->{memo}"; } if ($form->{transdatefrom}) { $callback .= "&transdatefrom=$form->{transdatefrom}"; $href .= "&transdatefrom=$form->{transdatefrom}"; $option .= "\n
" if ($option); $option .= $locale->text('From')." ".$locale->date(\%myconfig, $form->{transdatefrom}, 1); } if ($form->{transdateto}) { $callback .= "&transdateto=$form->{transdateto}"; $href .= "&transdateto=$form->{transdateto}"; $option .= "\n
" if ($option); $option .= $locale->text('To')." ".$locale->date(\%myconfig, $form->{transdateto}, 1); } if ($form->{open}) { $callback .= "&open=$form->{open}"; $href .= "&open=$form->{open}"; $option .= "\n
" if ($option); $option .= $locale->text('Open'); } if ($form->{closed}) { $callback .= "&closed=$form->{closed}"; $href .= "&closed=$form->{closed}"; $option .= "\n
" if ($option); $option .= $locale->text('Closed'); } if ($form->{onhold}) { $callback .= "&onhold=$form->{onhold}"; $href .= "&onhold=$form->{onhold}"; $option .= "\n
" if ($option); $option .= $locale->text('On Hold'); } if ($form->{paidlate}) { $callback .= "&paidlate=$form->{paidlate}"; $href .= "&paidlate=$form->{paidlate}"; $option .= "\n
" if ($option); $option .= $locale->text('Paid Late'); } if ($form->{paidearly}) { $callback .= "&paidearly=$form->{paidearly}"; $href .= "&paidearly=$form->{paidearly}"; $option .= "\n
" if ($option); $option .= $locale->text('Paid Early'); } @columns = $form->sort_columns(qw(transdate id invnumber ordnumber ponumber description name customernumber vendornumber address netamount tax amount paid paymentmethod due curr datepaid duedate memo notes till employee warehouse shippingpoint shipvia waybill dcn paymentdiff department)); pop @columns if $form->{department}; unshift @columns, "runningnumber"; @column_index = (); foreach $item (@columns) { if ($form->{"l_$item"} eq "Y") { push @column_index, $item; if ($form->{l_curr} && $item =~ /(amount|tax|paid|due)/) { push @column_index, "fx_$item"; } # add column to href and callback $callback .= "&l_$item=Y"; $href .= "&l_$item=Y"; } } if (!$form->{summary}) { @f = grep !/memo/, @column_index; @column_index = (@f, (qw(source debit credit accno memo projectnumber))); } if ($form->{l_subtotal} eq 'Y') { $callback .= "&l_subtotal=Y"; $href .= "&l_subtotal=Y"; } if ($form->{vc} eq 'customer') { $employee = $locale->text('Salesperson'); $name = $locale->text('Customer'); $namenumber = $locale->text('Customer Number'); $namefld = "customernumber"; } else { $employee = $locale->text('Employee'); $name = $locale->text('Vendor'); $namenumber = $locale->text('Vendor Number'); $namefld = "vendornumber"; } $column_data{runningnumber} = qq| |; $column_data{id} = "".$locale->text('ID').""; $column_data{transdate} = "".$locale->text('Date').""; $column_data{duedate} = "".$locale->text('Due Date').""; $column_data{invnumber} = "".$locale->text('Invoice').""; $column_data{ordnumber} = "".$locale->text('Order').""; $column_data{ponumber} = "".$locale->text('PO Number').""; $column_data{name} = "$name"; $column_data{$namefld} = "$namenumber"; $column_data{address} = "" . $locale->text('Address') . ""; $column_data{netamount} = "" . $locale->text('Amount') . ""; $column_data{tax} = "" . $locale->text('Tax') . ""; $column_data{amount} = "" . $locale->text('Total') . ""; $column_data{paid} = "" . $locale->text('Paid') . ""; $column_data{paymentmethod} = "" . $locale->text('Payment Method') . ""; $column_data{datepaid} = "" . $locale->text('Date Paid') . ""; $column_data{due} = "" . $locale->text('Due') . ""; $column_data{notes} = "".$locale->text('Notes').""; $column_data{employee} = "$employee"; $column_data{till} = "".$locale->text('Till').""; $column_data{warehouse} = qq||.$locale->text('Warehouse').qq||; $column_data{shippingpoint} = "" . $locale->text('Shipping Point') . ""; $column_data{shipvia} = "" . $locale->text('Ship via') . ""; $column_data{waybill} = "" . $locale->text('Waybill') . ""; $column_data{dcn} = "" . $locale->text('DCN') . ""; $column_data{paymentdiff} = "" . $locale->text('+/-') . ""; $column_data{curr} = "" . $locale->text('Curr') . ""; for (qw(amount tax netamount paid due)) { $column_data{"fx_$_"} = " " } $column_data{department} = "" . $locale->text('Department') . ""; $column_data{accno} = "" . $locale->text('Account') . ""; $column_data{source} = "" . $locale->text('Source') . ""; $column_data{debit} = "" . $locale->text('Debit') . ""; $column_data{credit} = "" . $locale->text('Credit') . ""; $column_data{projectnumber} = "" . $locale->text('Project') . ""; $column_data{description} = "" . $locale->text('Description') . ""; $column_data{memo} = "" . $locale->text('Line Item') . ""; $form->{title} = ($form->{title}) ? $form->{title} : $locale->text('AR Transactions'); $form->{title} .= " / $form->{company}"; $form->header; print qq|
$form->{helpref}$form->{title}
$option
|; for (@column_index) { print "\n$column_data{$_}" } print qq| |; # add sort and escape callback, this one we use for the add sub $form->{callback} = $callback .= "&sort=$form->{sort}"; # escape callback for href $callback = $form->escape($callback); if (@{ $form->{transactions} }) { $sameitem = $form->{transactions}->[0]->{$form->{sort}}; } # sums and tax on reports by Antonio Gallardo # $i = 0; foreach $ref (@{ $form->{transactions} }) { $i++; if ($form->{l_subtotal} eq 'Y') { if ($sameitem ne $ref->{$form->{sort}}) { &subtotal; $sameitem = $ref->{$form->{sort}}; } } if ($form->{l_curr}) { for (qw(netamount amount paid)) { $ref->{"fx_$_"} = $ref->{$_}/$ref->{exchangerate} } for (qw(netamount amount paid)) { $column_data{"fx_$_"} = "" } $column_data{fx_tax} = ""; $column_data{fx_due} = ""; $subtotalfxnetamount += $ref->{fx_netamount}; $subtotalfxamount += $ref->{fx_amount}; $subtotalfxpaid += $ref->{fx_paid}; $totalfxnetamount += $ref->{fx_netamount}; $totalfxamount += $ref->{fx_amount}; $totalfxpaid += $ref->{fx_paid}; } $column_data{runningnumber} = ""; for (qw(netamount amount paid debit credit)) { $column_data{$_} = "" } $column_data{tax} = ""; $column_data{due} = ""; $subtotalnetamount += $ref->{netamount}; $subtotalamount += $ref->{amount}; $subtotalpaid += $ref->{paid}; $subtotaldebit += $ref->{debit}; $subtotalcredit += $ref->{credit}; $totalnetamount += $ref->{netamount}; $totalamount += $ref->{amount}; $totalpaid += $ref->{paid}; $totaldebit += $ref->{debit}; $totalcredit += $ref->{credit}; $module = ($ref->{invoice}) ? ($form->{ARAP} eq 'AR') ? "is.pl" : "ir.pl" : $form->{script}; $module = ($ref->{till}) ? "ps.pl" : $module; $column_data{invnumber} = ""; for (qw(notes description memo)) { $ref->{$_} =~ s/\r?\n/
/g } for (qw(transdate datepaid duedate)) { $column_data{$_} = "" } for (qw(department ordnumber ponumber notes warehouse shippingpoint shipvia waybill employee till source memo description projectnumber address dcn paymentmethod)) { $column_data{$_} = "" } $column_data{$namefld} = ""; if ($ref->{paymentdiff} <= 0) { $column_data{paymentdiff} = qq||; } else { $column_data{paymentdiff} = qq||; } for (qw(id curr)) { $column_data{$_} = "" } $column_data{accno} = qq||; $column_data{name} = qq||; if ($ref->{id} != $sameid) { $j++; $j %= 2; } print " "; for (@column_index) { print "\n$column_data{$_}" } print qq| |; $sameid = $ref->{id}; } if ($form->{l_subtotal} eq 'Y') { &subtotal; } # print totals print qq| |; for (@column_index) { $column_data{$_} = "" } $column_data{netamount} = ""; $column_data{tax} = ""; $column_data{amount} = ""; $column_data{paid} = ""; $column_data{due} = ""; $column_data{debit} = ""; $column_data{credit} = ""; if ($form->{l_curr} && $form->{sort} eq 'curr' && $form->{l_subtotal}) { $column_data{fx_netamount} = ""; $column_data{fx_tax} = ""; $column_data{fx_amount} = ""; $column_data{fx_paid} = ""; $column_data{fx_due} = ""; } for (@column_index) { print "\n$column_data{$_}" } if ($myconfig{acs} !~ /$form->{ARAP}--$form->{ARAP}/) { $i = 1; if ($form->{ARAP} eq 'AR') { $button{'AR--Add Transaction'}{code} = qq| |; $button{'AR--Add Transaction'}{order} = $i++; $button{'AR--Sales Invoice'}{code} = qq| |; $button{'AR--Sales Invoice'}{order} = $i++; } else { $button{'AP--Add Transaction'}{code} = qq| |; $button{'AP--Add Transaction'}{order} = $i++; $button{'AP--Vendor Invoice'}{code} = qq| |; $button{'AP--Vendor Invoice'}{order} = $i++; } foreach $item (split /;/, $myconfig{acs}) { delete $button{$item}; } } print qq|
".$form->format_amount(\%myconfig, $ref->{"fx_$_"}, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $ref->{fx_amount} - $ref->{fx_netamount}, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $ref->{fx_amount} - $ref->{fx_paid}, $form->{precision}, " ")."$i".$form->format_amount(\%myconfig, $ref->{$_}, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $ref->{amount} - $ref->{netamount}, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $ref->{amount} - $ref->{paid}, $form->{precision}, " ")."{id}&path=$form->{path}&login=$form->{login}&callback=$callback>$ref->{invnumber} $ref->{$_} $ref->{$_} $ref->{$namefld} $ref->{paymentdiff} +$ref->{paymentdiff} $ref->{$_}$ref->{accno}{path}&login=$form->{login}&action=edit&id=$ref->{"$form->{vc}_id"}&db=$form->{vc}&callback=$callback>$ref->{name}
 ".$form->format_amount(\%myconfig, $totalnetamount, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totalamount - $totalnetamount, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totalamount, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totalpaid, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totalamount - $totalpaid, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totaldebit, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totalcredit, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totalfxnetamount, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totalfxamount - $totalfxnetamount, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totalfxamount, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totalfxpaid, $form->{precision}, " ")."".$form->format_amount(\%myconfig, $totalfxamount - $totalfxpaid, $form->{precision}, " ")."

{script}> |; $form->{helpref} = $form->escape($form->{helpref},1); $form->hide_form("$form->{vc}", "$form->{vc}_id"); $form->hide_form(qw(helpref callback path login)); if (! $form->{till}) { foreach $item (sort { $a->{order} <=> $b->{order} } %button) { print $item->{code}; } } if ($form->{menubar}) { require "$form->{path}/menu.pl"; &menubar; } print qq|
|; } sub subtotal { for (@column_index) { $column_data{$_} = " " } $column_data{tax} = "".$form->format_amount(\%myconfig, $subtotalamount - $subtotalnetamount, $form->{precision}, " ").""; $column_data{amount} = "".$form->format_amount(\%myconfig, $subtotalamount, $form->{precision}, " ").""; $column_data{paid} = "".$form->format_amount(\%myconfig, $subtotalpaid, $form->{precision}, " ").""; $column_data{due} = "".$form->format_amount(\%myconfig, $subtotalamount - $subtotalpaid, $form->{precision}, " ").""; $column_data{debit} = "".$form->format_amount(\%myconfig, $subtotaldebit, $form->{precision}, " ").""; $column_data{credit} = "".$form->format_amount(\%myconfig, $subtotalcredit, $form->{precision}, " ").""; if ($form->{l_curr} && $form->{sort} eq 'curr' && $form->{l_subtotal}) { $column_data{fx_tax} = "".$form->format_amount(\%myconfig, $subtotalfxamount - $subtotalfxnetamount, $form->{precision}, " ").""; $column_data{fx_amount} = "".$form->format_amount(\%myconfig, $subtotalfxamount, $form->{precision}, " ").""; $column_data{fx_paid} = "".$form->format_amount(\%myconfig, $subtotalfxpaid, $form->{precision}, " ").""; $column_data{fx_due} = "".$form->format_amount(\%myconfig, $subtotalfxmount - $subtotalfxpaid, $form->{precision}, " ").""; } $subtotalnetamount = 0; $subtotalamount = 0; $subtotalpaid = 0; $subtotaldebit = 0; $subtotalcredit = 0; $subtotalfxnetamount = 0; $subtotalfxamount = 0; $subtotalfxpaid = 0; print ""; for (@column_index) { print "\n$column_data{$_}" } print " "; } sub consolidate { AA->consolidate(\%myconfig, \%$form); $form->{title} = $locale->text('Consolidate'); %button = ('Consolidate Transactions' => { ndx => 1, key => 'C', value => $locale->text('Consolidate Transactions') } ); $module = $form->{script}; if ($form->{ARAP} eq 'AR') { if ($form->{type} eq 'invoice') { $module = "is.pl"; %button = ('Consolidate Invoices' => { ndx => 1, key => 'C', value => $locale->text('Consolidate Invoices') } ); } } else { if ($form->{type} eq 'invoice') { $module = "ir.pl"; %button = ('Consolidate Invoices' => { ndx => 1, key => 'C', value => $locale->text('Consolidate Invoices') } ); } } @column_index = qw(ndx transdate invnumber description amount); $column_data{ndx} = " "; $column_data{transdate} = "".$locale->text('Date').""; $column_data{invnumber} = "".$locale->text('Invoice').""; $column_data{description} = "".$locale->text('Description').""; $column_data{amount} = "".$locale->text('Amount').""; $colspan = $#column_index + 1; $form->helpref("consolidate", $myconfig{countrycode}); $title = "$form->{title} / $form->{company}"; $form->{callback} = "$form->{script}?action=consolidate"; for (qw(type path login)) { $form->{callback} .= qq|&$_=$form->{$_}| } # escape callback for href $callback = $form->escape($form->{callback}); $form->header; JS->check_all(qw(allbox ndx_)); print qq|
$form->{helpref}$title
|; $column_data{ndx} = qq||; for (@column_index) { print "\n$column_data{$_}" } print qq| |; for $curr (sort keys %{ $form->{all_transactions} }) { if ($form->{$curr} > 1) { print qq| |; for $accno (sort keys %{ $form->{all_transactions}{$curr} }) { for $name (sort keys %{ $form->{all_transactions}{$curr}{$accno} }) { if ($#{@{ $form->{all_transactions}{$curr}{$accno}{$name} }} > 0) { print qq| |; for $ref (@{ $form->{all_transactions}{$curr}{$accno}{$name} }) { $j++; $j %= 2; print qq| |; for (@column_index) { $column_data{$_} = qq|| } $form->{ids} .= "$ref->{id} "; $column_data{ndx} = qq||; $column_data{amount} = qq||; $column_data{invnumber} = ""; if ($name eq $samename) { for (qw(name city)) { $column_data{$_} = qq|| } } else { $column_data{name} = qq||; } for (@column_index) { print "\n$column_data{$_}" } $samename = $name; print qq| |; } } } } } } chop $form->{ids}; print qq|
{allbox} onChange="CheckAll()">
$curr
$name / $form->{all_transactions}{$curr}{$accno}{$name}->[0]->{city}
$ref->{$_}|.$form->format_amount(\%myconfig, $ref->{amount}, $ref->{prec}).qq|{id}&path=$form->{path}&login=$form->{login}&callback=$callback>$ref->{invnumber}  {path}&login=$form->{login}&action=edit&id=$ref->{"$form->{vc}_id"}&db=$form->{vc}&callback=$callback>$ref->{name}
|; $form->hide_form(qw(ids callback path login)); for (sort { $button{$a}->{ndx} <=> $button{$b}->{ndx} } keys %button) { $form->print_button(\%button, $_) } if ($form->{menubar}) { require "$form->{path}/menu.pl"; &menubar; } print qq|
|; } sql-ledger/bin/mozilla/admin.pl0000644000175000017500000006122711333114561017131 0ustar dsimaderdsimader#===================================================================== # SQL-Ledger ERP # Copyright (c) 2006 # # Author: DWS Systems Inc. # Web: http://www.sql-ledger.com # #====================================================================== # # setup module # add/edit/delete users # #====================================================================== use SL::Form; use SL::User; $form = new Form; $locale = new Locale $language, "admin"; $form->{charset} = $locale->{charset}; eval { require DBI; }; $form->error($locale->text('DBI not installed!')) if ($@); $form->{stylesheet} = "sql-ledger.css"; $form->{favicon} = "favicon.ico"; $form->{timeout} = 86400; $form->{"root login"} = 1; require "$form->{path}/pw.pl"; # customization if (-f "$form->{path}/custom_$form->{script}") { eval { require "$form->{path}/custom_$form->{script}"; }; $form->error($@) if ($@); } if ($form->{action}) { &check_password unless $form->{action} eq $locale->text('logout'); &{ $locale->findsub($form->{action}) }; } else { # if there are no drivers bail out $form->error($locale->text('Database Driver missing!')) unless (User->dbdrivers); # create memberfile if (! -f $memberfile) { &change_password; exit; } &adminlogin; } 1; # end sub adminlogin { $form->{title} = qq|SQL-Ledger |.$locale->text('Version').qq| $form->{version} |.$locale->text('Administration'); $form->header; print qq|

|.$locale->text('Version').qq| $form->{version}

|.$locale->text('Administration').qq|

{path}>
|.$locale->text('Password').qq|
SQL-Ledger |.$locale->text('website').qq|
|; } sub create_config { $form->{sessionkey} = ""; $form->{sessioncookie} = ""; if ($form->{password}) { my $t = time + $form->{timeout}; srand( time() ^ ($$ + ($$ << 15)) ); $key = "root login$form->{password}$t"; my $i = 0; my $l = length $key; my $j = $l; my %ndx = (); my $pos; while ($j > 0) { $pos = int rand($l); next if $ndx{$pos}; $ndx{$pos} = 1; $form->{sessioncookie} .= substr($key, $pos, 1); $form->{sessionkey} .= substr("0$pos", -2); $j--; } } open(CONF, ">$userspath/root login.conf") or $form->error("root login.conf : $!"); print CONF qq|# configuration file for root login \%rootconfig = ( sessionkey => '$form->{sessionkey}' );\n\n|; close CONF; } sub login { &create_config; &list_datasets; } sub logout { $form->{callback} = "$form->{script}?path=$form->{path}"; $form->redirect($locale->text('You are logged out')); } sub edit { $form->{title} = "SQL-Ledger ".$locale->text('Administration'); if (-f "$userspath/$form->{dbname}.LCK") { open(FH, "$userspath/$form->{dbname}.LCK") or $form->error("$userspath/$form->{dbname}.LCK : $!"); $form->{lock} = ; close(FH); } &form_header; &form_footer; } sub form_footer { $nologin = qq| |; if (-f "$userspath/$form->{dbname}.LCK") { $nologin = qq| |; } $delete = qq||; $form->{callback} = "$form->{script}?action=list_datasets&path=$form->{path}"; $form->hide_form(qw(company dbname path callback)); print qq| $nologin $delete |; } sub list_datasets { # type=submit $locale->text('Pg') # type=submit $locale->text('PgPP') # type=submit $locale->text('Oracle') # type=submit $locale->text('Sybase') open(FH, "$memberfile") or $form->error("$memberfile : $!"); my @member = ; close(FH); $nologin = qq| |; if (-f "$userspath/nologin.LCK") { $nologin = qq| |; } $login = ""; while (@member) { $_ = shift @member; if (/^\[.*\]/) { %temp = (); do { if (/^(company|dbname|dbdriver|dbhost|dbuser)=/) { chop ($var = $&); ($null, $temp{$var}) = split /=/, $_, 2; } $_ = shift @member; } until /^\s+$/; chop $temp{dbname}; for (keys %temp) { $member{$temp{dbname}}{$_} = $temp{$_} } $member{$temp{dbname}}{locked} = "x" if -f "$userspath/$member{$temp{dbname}}{dbname}.LCK"; } } delete $member{""}; $column_data{company} = qq||.$locale->text('Company').qq||; $column_data{dbdriver} = qq||.$locale->text('Driver').qq||; $column_data{dbhost} = qq||.$locale->text('Host').qq||; $column_data{dbuser} = qq||.$locale->text('User').qq||; $column_data{dbname} = qq||.$locale->text('Dataset').qq||; $column_data{locked} = qq||.$locale->text('Locked').qq||; @column_index = qw(dbname company locked dbdriver dbuser dbhost); $dbdriver ||= "Pg"; $dbdriver{$dbdriver} = "checked"; for (User->dbdrivers) { $dbdrivers .= qq| |.$locale->text($_).qq| |; } $form->{title} = "SQL-Ledger ".$locale->text('Administration'); $form->header; print qq|
{script}>
$form->{title}
|; for (@column_index) { print "$column_data{$_}\n" } print qq| |; foreach $key (sort keys %member) { chomp $member{$key}{company}; $href = "$script?action=edit&dbname=$key&path=$form->{path}&company=$member{$key}{company}&locked=$member{$key}{locked}"; $href =~ s/ /%20/g; $member{$key}{dbname} = $member{$key}{dbuser} if ($member{$key}{dbdriver} eq 'Oracle'); $column_data{company} = qq||; $column_data{dbdriver} = qq||; $column_data{dbhost} = qq||; $column_data{dbuser} = qq||; $column_data{dbname} = qq||; $column_data{locked} = qq||; $i++; $i %= 2; print qq| |; for (@column_index) { print "$column_data{$_}\n" } print qq| |; } print qq|
$member{$key}{company}$member{$key}{dbdriver}$member{$key}{dbhost}$member{$key}{dbuser}$member{$key}{dbname}$member{$key}{locked}
{path}> $dbdrivers

$nologin

|; } sub add_dataset { &{ "$form->{dbdriver}" } } sub form_header { $form->header; if ($form->{locked}) { $locked = qq| $form->{lock}|; } else { $locked = qq| |; } print qq|
{script}>
$form->{title}
$locked
|.$locale->text('Company').qq| $form->{company}
|.$locale->text('Dataset').qq| $form->{dbname}
|.$locale->text('Lock Message').qq|
|; } sub delete { $form->{title} = $locale->text('Confirm!'); $form->header; print qq| {script}> |; $form->{nextsub} = "do_delete"; $form->{action} = "do_delete"; delete $form->{script}; $form->hide_form; print qq|

$form->{title}

|.$locale->text('Are you sure you want to delete dataset').qq| $form->{dbname}

|; } sub do_delete { $form->{db} = $form->{dbname}; $form->error("$memberfile : ".$locale->text('locked!')) if (-f ${memberfile}.LCK); open(FH, ">${memberfile}.LCK") or $form->error("${memberfile}.LCK : $!"); close(FH); if (! open(FH, "+<$memberfile")) { unlink "${memberfile}.LCK"; $form->error("$memberfile : $!"); } @db = ; for (@db) { last if /^\[/; push @member, $_; } # get variables for dbname while (@db) { $_ = shift @db; if (/^\[(.*)\]/) { $user = $+; %temp = (); do { chop; ($var, $value) = split /=/, $_, 2; if ($value) { $temp{$var} = $value; } $_ = shift @db; } until /^\s/; for (keys %temp) { $db{$temp{dbname}}{$_} = $temp{$_}; $member{$temp{dbname}}{$user}{$_} = $temp{$_}; } } } $form->{dbdriver} = $db{$form->{dbname}}{dbdriver}; &dbdriver_defaults; for (qw(dbconnect dbuser dbhost dbport)) { $form->{$_} = $db{$form->{dbname}}{$_} } $form->{dbpasswd} = unpack 'u', $db{$form->{dbname}}{dbpasswd}; # delete dataset User->dbdelete(\%$form); # delete conf for users for (keys %{ $member{$form->{dbname}} }) { unlink "$userspath/${_}.conf"; } delete $member{$form->{dbname}}; seek(FH, 0, 0); truncate(FH, 0); for (@member) { print FH $_; } for $db (sort keys %member) { for $user (sort keys %{ $member{$db} }) { print FH "\[$user\]\n"; for $var (sort keys %{ $member{$db}{$user} }) { print FH "${var}=$member{$db}{$user}{$var}\n"; } print FH "\n"; } } close(FH); unlink "${memberfile}.LCK"; unlink "$userspath/$form->{dbname}.LCK"; # delete spool and template directory for $dir ("$templates/$form->{dbname}", "$spool/$form->{dbname}") { if (-d "$dir") { opendir DIR, $dir; @all = grep !/^\./, readdir DIR; closedir DIR; for $subdir (@all) { if (-d "$dir/$subdir") { unlink <$dir/$subdir/*>; rmdir "$dir/$subdir"; } } unlink <$dir/*>; rmdir "$dir"; } } $form->redirect($locale->text('Dataset deleted!')); } sub change_password { $form->{title} = $locale->text('Change Password'); $form->header; print qq|
{script}>
$form->{title}
|.$locale->text('Password').qq|
|.$locale->text('Confirm').qq|
|; $form->{nextsub} = "do_change_password"; $form->hide_form(qw(path nextsub)); print qq|
|; } sub do_change_password { $form->error($locale->text('Passwords do not match!')) if $form->{new_password} ne $form->{confirm_password}; $root->{password} = $form->{new_password}; if (! -f $memberfile) { open(FH, ">$memberfile") or $form->error("$memberfile : $!"); print FH qq|# SQL-Ledger members [root login] |; close FH; } $root->{'root login'} = 1; $root->{login} = "root login"; $root->save_member($memberfile); $form->{password} = $form->{new_password}; &create_config; $form->{callback} = "$form->{script}?action=list_datasets&path=$form->{path}&password=$form->{password}"; $form->redirect($locale->text('Password changed!')); } sub check_password { $root = new User "$memberfile", "root login"; $rootname = "root login"; eval { require "$userspath/${rootname}.conf"; }; if ($root->{password}) { if ($form->{password}) { $form->{callback} .= "&password=$form->{password}" if $form->{callback}; if ($root->{password} ne crypt $form->{password}, 'ro') { &getpassword; exit; } # create config &create_config; } else { if ($ENV{HTTP_USER_AGENT}) { $ENV{HTTP_COOKIE} =~ s/;\s*/;/g; @cookies = split /;/, $ENV{HTTP_COOKIE}; %cookie = (); foreach (@cookies) { ($name,$value) = split /=/, $_, 2; $cookie{$name} = $value; } $cookie = ($form->{path} eq 'bin/lynx') ? $cookie{login} : $cookie{"SL-root login"}; if ($cookie) { $form->{sessioncookie} = $cookie; $s = ""; %ndx = (); $l = length $form->{sessioncookie}; for $i (0 .. $l - 1) { $j = substr($rootconfig{sessionkey}, $i * 2, 2); $ndx{$j} = substr($cookie, $i, 1); } for (sort keys %ndx) { $s .= $ndx{$_}; } $l = length 'root login'; $login = substr($s, 0, $l); $time = substr($s, -10); $password = substr($s, $l, (length $s) - ($l + 10)); if ((time > $time) || ($login ne 'root login') || ($root->{password} ne crypt $password, 'ro')) { &getpassword; exit; } } else { &getpassword; exit; } } else { &getpassword; exit; } } } } sub Pg { &dbselect_source } sub PgPP { &dbselect_source } sub Oracle { &dbselect_source } sub Sybase { &dbselect_source } sub dbdriver_defaults { # load some defaults for the selected driver %driverdefaults = ( 'Pg' => { dbport => '', dbuser => 'sql-ledger', dbdefault => 'template1', dbhost => '', connectstring => $locale->text('Connect to') }, 'Oracle' => { dbport => '1521', dbuser => 'oralin', dbdefault => $sid, dbhost => `hostname`, connectstring => 'SID' }, 'Sybase' => { dbport => '', dbuser => 'sql-ledger', dbdefault => '', dbhost => '', connectstring => $locale->text('Connect to') } ); $driverdefaults{PgPP} = $driverdefaults{Pg}; for (keys %{ $driverdefaults{Pg} }) { $form->{$_} = $driverdefaults{$form->{dbdriver}}{$_} } } sub dbselect_source { &dbdriver_defaults; $form->{title} = "SQL-Ledger / ".$locale->text('Add Dataset'); $form->{callback} = "$form->{script}?action=list_datasets&path=$form->{path}"; $form->header; print qq|
{script}>
$form->{title}
|.$locale->text('Host').qq| {dbhost}> |.$locale->text('Port').qq| {dbport}>
|.$locale->text('User').qq| {dbuser}> |.$locale->text('Password').qq| {dbpasswd}>
$form->{connectstring} {dbdefault}>

|; $form->{nextsub} = "create_dataset"; $form->hide_form(qw(dbdriver path nextsub callback)); print qq|
|; } sub continue { &{ $form->{nextsub} } } sub yes { &{ $form->{nextsub} } } sub create_dataset { @dbsources = sort User->dbsources(\%$form); opendir SQLDIR, "sql/." or $form->error($!); foreach $item (sort grep /-chart\.sql/, readdir SQLDIR) { next if ($item eq 'Default-chart.sql'); $item =~ s/-chart\.sql//; push @charts, qq|$item|; } closedir SQLDIR; # is there a template basedir if (! -d "$templates") { $form->error($locale->text('Directory').": $templates ".$locale->text('does not exist')); } opendir TEMPLATEDIR, "$templates/." or $form->error("$templates : $!"); @all = grep !/^\.\.?$/, readdir TEMPLATEDIR; closedir TEMPLATEDIR; @allhtml = sort grep /\.html/, @all; @allhtml = reverse grep !/Default/, @allhtml; push @allhtml, 'Default'; @allhtml = reverse @allhtml; for (sort @alldir) { $selectusetemplates .= qq|$_\n| } $lastitem = $allhtml[0]; $lastitem =~ s/-.*//g; $selectmastertemplates = qq|$lastitem\n|; for (@allhtml) { $_ =~ s/-.*//g; if ($_ ne $lastitem) { $selectmastertemplates .= qq|$_\n|; $lastitem = $_; } } # add Default at beginning unshift @charts, qq|Default|; $selectencoding{Pg} = qq|