#!perl
use lib '/wwwroot/extranet/';
use me;
my $mysqldir = '/mysql/data/';
my $tdir = '/wwwroot/extranet/';
our $sessiondir = '/wwwsessions';
our $dbuser = 'root';
our $dbpassword = 'fbg4ips';
our $dbhost = '127.0.0.1';
use settings;
use strict;
#no strict 'refs';
use Storable;
use CGI::Carp qw(fatalsToBrowser);
use CGI;
use CGI::Session;
use Template;
use Template::Plugin::CGI;
use DBI;
my $folder = '/wwwroot/extranet/';
my $jobsdir = "/socket/jobs";
my $q = new CGI;
$q->import_names('R');
#################### SESSION #######################
#retreive cookie
CGI::Session->name("CGISESSIDSPACEBIZSET");
my $session = new CGI::Session(undef, $q,{Directory=>$sessiondir});
logininit($session,$q);
my $login_cookie = $q->cookie(-name=>"CGISESSIDSPACEBIZSET");
if ($login_cookie) {
$session->clear(["~logged-in"]) if $login_cookie ne $session->id();
} else {
$session->clear(["~logged-in"])
}
#if ( $session->param("~login-trials") >= 3 ) {
#print "You failed 3 times in a row. Please ask your administrator for assistance.";
#}
my %cookies = fetch CGI::Cookie;
my $store_session_cookie = $q->cookie(-name=>"CGISESSIDSPACEBIZSET",-value => $session->id(),-expires => "+365d");
my $logexp = 0;
my $login_session_cookie = $q->cookie(-name=>"CGISESSIDSPACEBIZSET",-value => $session->id(), -expires => $logexp );
print $q->header(-cookie => [$store_session_cookie,$login_session_cookie]);
################### / SESSION ######################
my $template = slurpfile($folder."profiles/template.htm");
if ($R::action eq "logche") {
#verify user and password quickly
my $dbh = DBI->connect("DBI:mysql:spaceusers;host=$dbhost",$dbuser,$dbpassword) or die $DBI::errstr;
my $results = $dbh->prepare("
select * from spaceusers.users where username=? and password=? and type=2;
;") or die $dbh->errstr();
$results->execute($R::lg_name, $R::lg_password) or die $results->errstr();
my $ref = $results->fetchrow_hashref();
if ( $ref->{username} ) {
print "welcome back";
} else {
if (! $R::lg_password) {
print "password please";
} else {
print "password still not full";
}
}
} elsif ( $session->param("~logged-in") ) { #start normal operation
#--------------------------------------------------------------------------------------
if ($R::action eq 'generic') {
my $pro = $session->param("~profile");
my $db = DataBase2->new();
my %settings_pm;
my $db_name = $R::setting_db;
unless($db_name){ #donot's have db_name?
if(!$R::pro){
#do not have profile passed , let's choose one from DBI
my $userid = $pro->{userid};
#my $a_profile = $db->SelectRow("SELECT id,name,db_name FROM spaceusers.profiles
# WHERE id in(SELECT profile_id FROM spaceusers.user_profiles
# WHERE user_id=$userid) LIMIT 1");
my $a_profile = $db->SelectRow("SELECT id,name,db_name FROM spaceusers.profiles LIMIT 1");
$R::pro = $a_profile->{id};
$db_name= $a_profile->{db_name};
}else{
my $a_profile = $db->SelectRow("SELECT id,name,db_name FROM spaceusers.profiles
WHERE id=?",$R::pro);
$db_name= $a_profile->{db_name};
}
}
my $setting_current_db = $db_name;
#Try to load settings from database first.
my $settings = $db->SelectARef("SELECT * FROM Settings WHERE db=?",$db_name) if $db_name;
foreach(@$settings){
$settings_pm{$_->{name}} = $_->{val} if $_->{name};
}
my $len = keys %settings_pm;
%settings_pm = %{retrieve('/wwwroot/extranet/settings_pm.sto')} if $len <1;
#add a new one ......
unless(exists($settings_pm{'accountcard'})){
$settings_pm{'accountcard'} = -1;
}
my $page = slurpfile($folder."profiles/settings_pm.html");
$page .= "<input type=hidden name=action value=$R::action>";
my @ses;
my @pars = $q->param; #/save if unsaved
foreach (@pars) {
if ($_ =~ /(SE_)(.*)/) {
push @ses, $2;
}
}
if ($R::command eq "Save Settings") {
print "settings saved.";
$db->Exec("DELETE FROM Settings WHERE db=?",$db_name);
foreach my $key (@ses) {
$settings_pm{$key} = $q->param("SE_$key");
$db->Exec("INSERT INTO Settings SET name=?,val=?,db=?",$key,$settings_pm{$key}||'',$db_name);
}
#store \%settings_pm, '/wwwroot/extranet/settings_pm.sto';
}
foreach my $key ( keys %settings_pm )
{
$page =~ s/\%SE_$key\%/$settings_pm{$key}/;
}
my ($setting_db_opt,$pro_list);
#my $list = $db->SelectARef("SELECT id,name,db_name FROM spaceusers.profiles
# WHERE id in(SELECT profile_id FROM spaceusers.user_profiles
# WHERE user_id=?)",$pro->{userid});
my $list = $db->SelectARef("SELECT id,name,db_name FROM spaceusers.profiles");
foreach(@$list){
my $selected = " selected" if $_->{db_name} eq $db_name;
$setting_db_opt .=qq|<option value="$_->{db_name}" $selected>$_->{name}</option>|;
$pro_list .=qq|<a href="#" onclick="gotoPro('$_->{id}')" title="Load From $_->{name}">$_->{name}</a> |;
}
$page =~ s/\%setting_db\%/$setting_db_opt/;
$page =~ s/\%pro_list\%/$pro_list/;
$page =~ s/\%SE_autoplace\%//;
$page =~ s/\%SE_clockview\%//;
$page =~ s/\%SE_alloworderbutton\%//;
$page =~ s/\%setting_current_db\%/$setting_current_db/;
$template =~ s/\%content\%/$page/;
#--------------------------------------------------------------------------------------
} elsif ($R::action eq 'restart') {
my $t = system('"\Program Files\Apache Group\Apache2\bin\Apache.exe" -k restart');
#print "Apache Restarted";
$template =~ s/\%content\%/Apache Restarted/;
#--------------------------------------------------------------------------------------
} elsif ($R::action eq 'headerfooter') {
if ($R::command eq "Save Settings") {
print "settings saved.";
$R::billheader =~ s/\r//gsi;
$R::billfooter =~ s/\r//gsi;
$R::billfooteri =~ s/\r//gsi;
open HEADER, ">/wwwroot/extranet/data/billtext.txt";
open ORDERHEADER, ">/wwwroot/extranet/data/orderheader.txt";
open FOOTER, ">/wwwroot/extranet/data/billfooter.txt"; #proforma
open FOOTERI, ">/wwwroot/extranet/data/billfooteri.txt";
print ORDERHEADER $R::orderheader;
print HEADER $R::billheader;
print FOOTER $R::billfooter;
print FOOTERI $R::billfooteri;
close ORDERHEADER;
close HEADER;
close FOOTER;
close FOOTERI;
}
my $page = slurpfile($folder."profiles/tillheadfoot.html");
$page .= "<input type=hidden name=action value=$R::action>";
my $header = slurpfile($folder."data/billtext.txt");
my $footer = slurpfile($folder."data/billfooter.txt");
my $footeri = slurpfile($folder."data/billfooteri.txt");
my $orderheader = slurpfile($folder."data/orderheader.txt");
$page =~ s/\%billheader\%/$header/;
$page =~ s/\%billfooter\%/$footer/;
$page =~ s/\%billfooteri\%/$footeri/;
$page =~ s/\%orderheader\%/$orderheader/;
$template =~ s/\%content\%/$page/;
#--------------------------------------------------------------------------------------
} elsif ($R::action eq 'stations') {
my $temphtml;
$temphtml .= "<br><table width=70% align=center><tr><td bgcolor=black>
<font color=white>[*] TERMINAL CONFIGURATION EDITOR | Folder: \\SPACEPOS_STATIONS
</td></tr><tr><td bgcolor=white>";
#commands
if ($R::command eq "Create Station") {
if ($R::newip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
if (! -d "/SPACEPOS_STATIONS/$R::newip") {
mkdir ("/SPACEPOS_STATIONS/$R::newip");
mkdir ("/SPACEPOS_STATIONS/$R::newip/Program Files");
mkdir ("/SPACEPOS_STATIONS/$R::newip/Program Files/lpd");
#copy files
copyfile ("/wwwroot/extranet/profiles/templates/LPD.INI","/SPACEPOS_STATIONS/$R::newip/Program Files/lpd/LPD.INI");
copyfile ("/wwwroot/extranet/profiles/templates/settings.txt","/SPACEPOS_STATIONS/$R::newip/settings.txt");
open (NICK, ">/SPACEPOS_STATIONS/$R::newip/nickname.txt");
print NICK $R::newnickname;
close NICK;
# Done.
$temphtml .= "<b>Success: an empty station configuration has been added for $R::newip</b><hr>";
} else {
$temphtml .= "<b><font color=red>Error: the required station ($R::newip) is already existing</b></font><hr>";
}
} else {
$temphtml .= "<b><font color=red>Error: the specified station IP ($R::newip) is invalid</b></font><hr>";
}
} elsif ($R::command eq "delete") {
unlink "/SPACEPOS_STATIONS/$R::station/settings.txt";
unlink "/SPACEPOS_STATIONS/$R::station/nickname.txt";
unlink "/SPACEPOS_STATIONS/$R::station/Program Files/lpd/LPD.INI";
rmdir "/SPACEPOS_STATIONS/$R::station/Program Files/lpd/";
rmdir "/SPACEPOS_STATIONS/$R::station/Program Files/";
rmdir "/SPACEPOS_STATIONS/$R::station/";
$temphtml .= "Station Configuration Folder Deleted.<br>" if (! -d "/SPACEPOS_STATIONS/$R::station");
$temphtml .= "<b>ERROR: There is a problem deleting the files in /SPACEPOS_STATIONS/$R::station/ <br>Please perform a manual folder removal.<br><br></b>" if (-d "/SPACEPOS_STATIONS/$R::station");
} elsif ($R::command eq "Save") {#save settings and printers
my $settingsfile;
my $ip = $R::station;
$settingsfile = slurpfile("/SPACEPOS_STATIONS/$ip/settings.txt") if (-f "/SPACEPOS_STATIONS/$ip/settings.txt");
open (SETTINGS,">/SPACEPOS_STATIONS/$ip/settings.txt");
while ($settingsfile =~ /\&(.*?)=(.*?)\&/sgi) {
print SETTINGS "&$1=".$q->param("SET_$1")."&\n";
}
close SETTINGS;
open NICK, ">/SPACEPOS_STATIONS/$ip/nickname.txt";
print NICK $R::stationnick;
close NICK;
my $LPD;
$LPD .= 'SPOOLDIR'."\r";;
$LPD .= 'c:\lpd'."\r";
$LPD .= ''."\r";
$LPD .= 'MAXCONN'."\r";
$LPD .= '100'."\r";
$LPD .= ''."\r";
$LPD .= 'NODNS'."\r";
$LPD .= ''."\r";
$LPD .= 'PRINTERS'."\r";
$LPD .= '@'."\r";
$LPD .= ''."\r";
$LPD .= 'HOSTS'."\r";
$LPD .= '192.168'."\r";
$LPD .= '10.0'."\r";
$LPD .= '10.10'."\r";
$LPD .= '127.0'."\r";
$LPD .= ''."\r";;
my $printers;
for (1..7) {
my $entry = $q->param("LPD_$_");
last if ($entry eq "");
$printers .= "$entry |$entry\r";
}
$LPD =~ s/\@/$printers/sgi;
open (LPDINI,">/SPACEPOS_STATIONS/$ip/Program Files/lpd/LPD.INI");
binmode LPDINI;
print LPDINI $LPD;
close LPDINI;
$temphtml .= "<b>Settings for station $ip successfuly saved.</b><br>";
}
my @stations;
if (opendir(STATIONS, "/SPACEPOS_STATIONS")) {
@stations = grep {/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/} readdir(STATIONS);
closedir STATIONS;
} else {
if (mkdir "/SPACEPOS_STATIONS") {
$temphtml .= "/SPACEPOS_STATIONS folder was successfuly created.";
};
}
$temphtml .= "<b>Configured stations:</b><ul>";
$temphtml .= "<table>";
foreach my $ip (@stations) {
$temphtml .= "<tr><td". ( ($R::subaction eq "edit" and $R::station eq $ip) ? " bgcolor=#F8ECA7> <b>" : " bgcolor=#FCF5D1>");
my $nickname;
$nickname = slurpfile("/SPACEPOS_STATIONS/$ip/nickname.txt") if (-f "/SPACEPOS_STATIONS/$ip/nickname.txt");
my $settingsfile;
$settingsfile = slurpfile("/SPACEPOS_STATIONS/$ip/settings.txt") if (-f "/SPACEPOS_STATIONS/$ip/settings.txt");
$settingsfile =~ /file_till_id=(.*?)\&/;
my $till_id = $1 if ($&);
$settingsfile =~ /server_ip=(.*?)\&/;
my $host = $1 if ($&);
$settingsfile =~ /cashdrawer_port=(.*?)\&/;
my $cashdrawerdev = $1 if ($&);
$temphtml .= "<li> $ip Nickname: <i><b>$nickname</b></i> |
[<a href=\"index.cgi?action=$R::action&subaction=edit&station=$ip\">edit station</a>]
[<a onClick=\"return confirm('Are you sure that you want to delete $ip?')\" href=\"index.cgi?action=$R::action&command=delete&station=$ip\">delete station</a>]
<br><font size=2 color=#0B9B1D>(Till ID: <b>$till_id</b> | Server IP: <b>$host</b> | Cashdrawer Port: <b>$cashdrawerdev</b>)</font>
<br>
";
$temphtml .= "</td></tr>";
if ($R::subaction eq "edit" and $R::station eq $ip) {
#parse LPD.INI
my @lpdprinters;
my $printsection = 0;
my $lpd_ini = slurpfile("/SPACEPOS_STATIONS/$ip/Program Files/lpd/LPD.INI")
if (-f "/SPACEPOS_STATIONS/$ip/Program Files/lpd/LPD.INI");
while ($lpd_ini =~ /(\w+|\w)(\s\|)/gsi) {
push @lpdprinters, $1;
}
$temphtml .= "<tr><td bgcolor=#CFCFCF>";
$temphtml .= "<ul><table><tr>";
$temphtml .= "<td valign=top align=center><b>SPACE POS SETTINGS</b><br>";
$temphtml .= "<table>";
while ($settingsfile =~ /\&(.*?)=(.*?)\&/sgi) {
$temphtml .= "<tr><td align=right>$1:</td><td><input name=\"SET_$1\" value=\"$2\"></td></tr>";
}
$temphtml .= "</table>";
$temphtml .= "</td><td valign=top align=center>";
$temphtml .= "<b>WINDOWS PRINTERS</b><br>";
for (1..7) {
$temphtml .= "<input type=text name=LPD_$_ value=\"".($lpdprinters[$_-1])."\"><br>";
}
$temphtml .= "</td>";
$temphtml .= "</tr>
<tr><td colspan=2 align=center>
Station Nickname: <input type=text name=stationnick value=\"$nickname\"><br>
<input type=hidden name=station value=$R::station>
<input type=submit name=command value=Save>
<input type=submit name=command value=Cancel>
</td></tr>
</table></ul>";
}
}
$temphtml .= "</table>";
$temphtml .= "<hr>New Station IP : <input type=text name=newip>
Nickname: <input type=text name=newnickname>
<input type=submit name=command value=\"Create Station\"> ";
$temphtml .= "<input type=hidden name=action value=\"$R::action\">";
#$temphtml .= "<input type=hidden name=subaction value=\"$R::subaction\">";
$temphtml .= "</td></tr></table>";
$template =~ s/\%content\%/$temphtml/;
#--------------------------------------------------------------------------------------
} elsif ($R::action eq 'printers') {
my $page = '<link rel="stylesheet" href="style.css" type="text/css">';
#actions
#/actions
my %printsetup_pm = %{retrieve('/wwwroot/extranet/printsetup_pm.sto')};
#commands
if ($R::command eq "alterprntype") {
$printsetup_pm{prntype}{$R::lpd_name} *= -1;
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
} elsif ($R::command eq "delete_lpd") {
if ( $R::lpd_name =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\// ) {
my ($ip,$que) = split (/\//, $R::lpd_name);
opendir (RDIR, "$jobsdir/$ip/$que");
my @currentjobs = grep {/job$|bad$|txt$/} readdir(RDIR);
closedir (RDIR);
unlink ("$jobsdir/$ip/$que/$_") foreach @currentjobs;
rmdir("$jobsdir/$ip/$que");
rmdir("$jobsdir/$ip");
if (! -d "$jobsdir/$ip/$que") {
delete $printsetup_pm{prntype}{$R::lpd_name};
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
} else {
print "<b><font color=red>Error deleting Queue Directory for $ip:$que. Close POS Server</font></b>";
}
} else {
delete $printsetup_pm{prntype}{$R::lpd_name};
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
}
} elsif ($R::command eq "add LPD printer" and $R::new_lpd_name) {
if ( $R::new_lpd_name =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\// ) {
my ($ip,$que) = split (/\//, $R::new_lpd_name);
#create jobs dir if missing.
mkdir ("$jobsdir") if (! -d "jobsdir");
mkdir ("$jobsdir/$ip");
mkdir ("$jobsdir/$ip/$que");
if (-d "$jobsdir/$ip/$que") {
$printsetup_pm{prntype}{$R::new_lpd_name} = ($R::prn_type == 1 ? 1 : -1);
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
} else {
print "<b><font color=red>Error creating Queue Directory for $ip:$que</font></b>";
}
} else {
$printsetup_pm{prntype}{$R::new_lpd_name} = ($R::prn_type == 1 ? 1 : -1);
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
}
} elsif ($R::command eq "delete_opd") {
delete $printsetup_pm{psubst}{$R::opd_name};
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
} elsif ($R::command eq "add destination") {
push @{ $printsetup_pm{psubst}{$R::opd_name} },$R::add_destination;
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
} elsif ($R::command eq "delete_destination") {
my @current = @{ $printsetup_pm{psubst}{$R::opd_name} };
my @newarr;
my $cnt = 0;
foreach my $val (@current) {
push @newarr, $val if ($cnt != $R::index);
$cnt ++;
}
@{ $printsetup_pm{psubst}{$R::opd_name} } = @newarr;
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
} elsif ($R::command eq "create Till printer") {
$printsetup_pm{psubst}{$R::opd_name} = [] if (! exists $printsetup_pm{psubst}{$R::opd_name});
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
} elsif ($R::command eq "Create Alternative Printer") {
if ($R::tillid and $R::oldorder and $R::altorder) {
$printsetup_pm{altord}{$R::tillid}{$R::oldorder} = $R::altorder;
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
$page .= "<font color=green size=3>Alternative printer created.</font>";
} else {
$page .= "<font color=red size=3>Provide all fields please.</font>";
}
} elsif ($R::command eq "delete_alt_printer") {
if ($R::tillid and $R::oldorder) {
$page .= "<font color=green size=3>Alternative printer deleted.</font>";
delete $printsetup_pm{altord}{$R::tillid}{$R::oldorder};
store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto';
}
}
#/commands
$page .= "<table align=center cellpadding=5 cellspacing=0 width=100%> <tr><td bgcolor=white>";
$page .= "<div align=center><img src=printers.gif></div><br>";
$page .= "<table align=center cellpadding=5> <tr><td bgcolor=white>";
$page .= "Defined LPD Printers (physical printers and existing LPD queues):<hr>";
foreach my $key ( sort {$a cmp $b} keys %{ $printsetup_pm{prntype} } ) {
$page .= "<li> <b>$key</b> (Type: ".(
$printsetup_pm{prntype}{$key} == 1
?
"<a href=index.cgi?action=$R::action&command=alterprntype&lpd_name=$key>epson</a>"
:
"<a href=index.cgi?action=$R::action&command=alterprntype&lpd_name=$key>non-epson</a>");
$page .= ") [<a href=index.cgi?action=$R::action&command=delete_lpd&lpd_name=$key>X</a>]";
}
$page .= "<hr> Queue Name: (eg. 127.0.0.1/kitchen)<br>
<input type=text name=new_lpd_name>
(Epson ? <input type=checkbox name=prn_type checked value=1>)
<input type=submit name=command value=\"add LPD printer\"><hr>";
$page .= "<table bgcolor=#C9E7E9><tr><td>";
$page .= "SpacePOS Till and Order Printers (used in PLU editor):<hr>";
foreach my $key ( sort {$a cmp $b} keys %{ $printsetup_pm{psubst} } ) {
$page .= "<li> <b>$key</b> ";
$page .= " <font color=#BC8F8F>STATION</font> " if ($key =~ /^T/);
$page .= "
[<a href=index.cgi?action=$R::action&command=add_to_opd&opd_name=$key>add destination</a>]
[<a href=index.cgi?action=$R::action&command=delete_opd&opd_name=$key>X</a>]";
$page .= "<ul>";
my $cnt =0;
foreach my $skey (@{ $printsetup_pm{psubst}{$key} }) {
$page .= "<li> $skey [<a href=\"index.cgi?action=$R::action&command=delete_destination&opd_name=$key&index=$cnt\">X</a>]";
$cnt ++;
$page .= " <b><font color=\"#ff8000\">Error!</font></b>" if (! exists $printsetup_pm{prntype}{$skey});
}
if ( ($R::command eq "add_to_opd") and ($key eq $R::opd_name) ) {
$page .= "<input type=hidden name=opd_name value=\"$R::opd_name\">";
$page .= "<li> <select name=add_destination>";
foreach my $dkey ( sort {$a cmp $b} keys %{ $printsetup_pm{prntype} } ) {
$page .= "<option value = \"$dkey\"> $dkey";
}
$page .= "</select> <input type=submit name=command value=\"add destination\">";
}
$page .= "</ul>";
}
$page .= "
<input type=text name=opd_name>
<input type=submit name=command value=\"create Till printer\">";
$page . "</td></tr></table>";
$page .= "<hr><table bgcolor=#FFFF80><tr><td>";
$page .= "<b>ORDER PRINTERS REDIRECTION RULES</b><hr>";
$page .= "<ul>";
#{altord}{$R::tillid}{$R::oldorder}
foreach my $shopid (sort keys %{$printsetup_pm{altord}}) {
foreach my $oldorder (sort {$a cmp $b} keys %{ $printsetup_pm{altord}{$shopid} }) {
$page .= "<li><i><font size=2>Orders placed from station ID <b> $shopid </b> for <b>$oldorder</b> will be redirected to <b>$printsetup_pm{altord}{$shopid}{$oldorder}</b></font>
[<a href=\"index.cgi?action=$R::action&command=delete_alt_printer&tillid=$shopid&oldorder=$oldorder\">X</a>]
</i><br>";
}
}
$page .= "</ul>";
$page .= "
Station Number (ID): <input size=3 type=text name=tillid>
Order Printer: <input size=3 type=text name=oldorder>
Alternative Order Printer: <input size=3 type=text name=altorder>
<input type=submit name=command value=\"Create Alternative Printer\"><br>";
$page .= "</td></tr></table>";
$page .= "</td></tr></table>";
$page .= "</td></tr></table>";
$page .= "<input type=hidden name=action value=$R::action>";
$page .= "<input type=hidden name=subaction value=$R::subaction>";
$template =~ s/\%content\%/$page/;
#--------------------------------------------------------------------------------------
} elsif ($R::action eq 'dbcreate') {
my $page = '<link rel="stylesheet" href="style.css" type="text/css">';
$page .= "<table align=center cellpadding=5 cellspacing=0 width=100%> <tr><td bgcolor=white>";
$page .= "<div align=center><img src=newdb.gif></div><br>";
$page .= "<table align=center cellpadding=5> <tr><td bgcolor=white>";
my $flag = 1;
my $dbh = DBI->connect("DBI:mysql:fbg_original;host=127.0.0.1",'root','fbg4ips') or
$flag = 0;
if ($flag) {
my %settings_pm = %{retrieve('/wwwroot/extranet/settings_pm.sto')};
my $db = "$R::dbname";
if ($R::command eq "Create database") {
my (@tables,@columns,@fetched);
my $results = $dbh->prepare("flush tables;") or die $dbh->errstr();
$results->execute() or die $results->errstr();
opendir (DD, "$R::path/fbg_original/");
my @flist = grep { -f "$R::path/fbg_original/$_" } readdir(DD);
closedir (DD);
mkdir "$R::path/$R::dbname";
foreach my $file (@flist) {
copyfile("$R::path/fbg_original/$file", "$R::path/$R::dbname/$file");
}
$results = $dbh->prepare("flush tables;") or die $dbh->errstr();
$results->execute() or die $results->errstr();
$page .= "Database created. <hr><big>VERY IMPORTANT NOTE<br> <b>(please print this short instruction)</b><br> Please specify
<li>Stock Types, <li>Stock Categories, <li>Stock Items,
<li>PLU Categories, <li>Components,products
<li>PLU Items <br> and then link the products to the PLU Items<hr>
";
}
my $existing = 1;
my $results = $dbh->prepare("show tables from $db;") or die $dbh->errstr();
$results->execute() or $existing = 0;
$page .= "<div align=center>";
$page .= "Current configuration is using database <b><big>$db</big></b><br>";
$page .= "<b><big>$db</big></b> is ".( $existing == 1 ? "existing" : "not existing.");
if ($existing != 1) {
$page .= "<hr> Mysql Data: <input type=text name=path value='$mysqldir'>";
$page .= "<hr> New Database Name: <input type=text name=dbname value='$settings_pm{abrev}_$settings_pm{shop_id}'>";
$page .= "<br><br><input type=submit name=command value=\"Create database\">";
}
$page .= "</div>";
} else {
$page .= "<font size=4 color=red>Error: Unable to connect to MySQL Server. Please make sure that it is running and there is no missing files.";
}
$page .= "</td></tr></table>";
$page .= "</td></tr></table>";
$page .= "<input type=hidden name=action value=$R::action>";
$page .= "<input type=hidden name=subaction value=$R::subaction>";
$template =~ s/\%content\%/$page/;
#--------------------------------------------------------------------------------------
} else {
my $page = slurpfile($folder."profiles/init.html");
$template =~ s/\%content\%/$page/;
}
print $template;
} else { #login failed
my $profile = $session->param("~profile");
my $username = $profile->{username};
login_page($username);
}
####
sub slurpfile
{
open(IN, "< $_[0]");# or die "can't open $_[0]: $!";
binmode (IN);
seek(IN, 0, 0); sysread (IN, my $slurp, -s IN);
close(IN);
return $slurp;
}
###############################################
############# COPY SINGLE FILE
sub copyfile
{
if (open(IN, "< $_[0]") ) {# or die "can't open $_[0]: $!";
open(OUT, "> $_[1]") ;# or die "can't open $_[1]: $!";
binmode (IN);
binmode (OUT);
my $blksize = (stat IN)[11] || 16384; # preferred block size?
my ($len,$buf,$written);
while ($len = sysread IN, $buf, $blksize) {
if (!defined $len) {
next if $! =~ /^Interrupted/; # ^Z and fg
die "System read error: $!\n";
}
my $offset = 0;
while ($len) { # Handle partial writes.
defined($written = syswrite OUT, $buf, $len, $offset)
or die "System write error: $!\n";
$len -= $written;
$offset += $written;
};
}
close(IN);
close(OUT);
return 1;
} else {
return 0;
}
}
#### LOGIN PROCEDURES ####
sub logininit {
my ($session, $cgi) = @_; # receive two args
if ($cgi->param("cmd") eq "logout") {
$session->clear(["~logged-in"]);
}
if ( $session->param("~logged-in") ) {
return 1; # if logged in, don't bother going further
}
my $lg_name = $cgi->param("lg_name") or return;
my $lg_psswd= $cgi->param("lg_password") or return;
# if we came this far, user did submit the login form
# so let's try to load his/her profile if name/psswds match
if ( my $profile = _load_profile($lg_name, $lg_psswd) ) {
#delete all old sessions for this user here;
$session->param("~profile", $profile);
$session->param("~logged-in", 1);
$session->clear(["~login-trials"]);
return 1;
}
# if we came this far, the login/psswds do not match
# the entries in the database
my $trials = $session->param("~login-trials") || 0;
return $session->param("~login-trials", ++$trials);
}
##########################################################
sub _load_profile {
my ($lg_name, $lg_psswd) = @_;
my $dbh = DBI->connect("DBI:mysql:spaceusers;host=$dbhost",$dbuser,$dbpassword) or die $DBI::errstr;
my $results = $dbh->prepare("select * from spaceusers.users where username=? and password=? and type=2;;") or die $dbh->errstr();
$results->execute($lg_name, $lg_psswd) or die $results->errstr();
my $ref = $results->fetchrow_hashref();
if ( $ref->{username} ) {
#delete existing old session for user
#register new session id in db
return {
userid => $ref->{id},
username => $lg_name,
};
} else { #incorrect login page message.
return undef;
}
}
##########################################################
sub login_page {
my $username = $_[0];
my $file = "$tdir/login.html";
my $output;
my $template = Template->new(ABSOLUTE => 1,COMPILE_EXT => '.ttc');
my $vars = {message => "", sessionusername => $username};
my $temphtml = $template->process($file, $vars, \$output)|| die "Template process failed: ", $template->error(), "\n";
print $output;
}
sub logit{
my ($year,$month,$day,$hour,$minute,$second) = getTime();
open FILE,">>$tdir/index.pm.log";
print FILE "\n==== $year-$month-$day $hour:$minute:$second ===\n";print FILE shift;print "\n";
close FILE;
}
sub getTime
{
my ($time) = @_;
my @t = $time ? localtime( $time ) : localtime();
return ( sprintf("%04d",$t[5]+1900),
sprintf("%02d",$t[4]+1),
sprintf("%02d",$t[3]),
sprintf("%02d",$t[2]),
sprintf("%02d",$t[1]),
sprintf("%02d",$t[0])
);
}
package DataBase2;
use DBI;
sub new{
my ($class, %opts) = @_;
my $self = { %opts };
#$self->{$_} for qw(db_name db_host db_login db_passwd);
$self->{db_name} = 'spaceusers';
$self->{db_host} = $dbhost;
$self->{db_login} = $dbuser;
$self->{db_passwd}= $dbpassword;
bless $self,$class;
$self->InitDB;
return $self;
}
sub inherit{
my $class = shift;
my $dbh = shift;
my $self={ dbh=>undef };
bless $self,$class;
$self->{dbh} = $dbh;
return $self;
}
sub dbh{shift->{dbh}}
sub InitDB{
my $self=shift;
$self->{dbh}=DBI->connect("DBI:mysql:database=$self->{'db_name'};host=$self->{'db_host'};",$self->{'db_login'},$self->{'db_passwd'}) || die ("Can't connect to Mysql server.".$! );
#$dbh->{'mysql_enable_utf8'} = 1;
#$self->Exec("SET NAMES 'utf8'");
$self->{'exec'}=0;
$self->{'select'}=0;
}
sub DESTROY{
shift->UnInitDB();
}
sub UnInitDB{
my $self=shift;
if($self->{dbh})
{
if($self->{locks})
{
$self->Unlock();
}
$self->{dbh}->disconnect;
}
$self->{dbh}=undef;
}
sub Exec
{
my $self=shift;
$self->{dbh}->do(shift,undef,@_) || die"Can't exec:\n".$self->{dbh}->errstr;
$self->{'exec'}++;
}
sub SelectOne
{
my $self=shift;
my $res = $self->{dbh}->selectrow_arrayref(shift,undef,@_);
die"Can't execute select:\n".$self->{dbh}->errstr if $self->{dbh}->err;
$self->{'select'}++;
return $res->[0];
};
sub SelectRow
{
my $self=shift;
my $res = $self->{dbh}->selectrow_hashref(shift,undef,@_);
die"Can't execute select:\n".$self->{dbh}->errstr if $self->{dbh}->err;
$self->{'select'}++;
return $res;
}
sub Select
{
my $self=shift;
my $res = $self->{dbh}->selectall_arrayref( shift, { Slice=>{} }, @_ );
die"Can't execute select:\n".$self->{dbh}->errstr if $self->{dbh}->err;
return undef if $#$res==-1;
my $cidxor=0;
for(@$res)
{
$cidxor = $cidxor ^ 1;
$_->{row_cid} = $cidxor;
}
$self->{'select'}++;
return $res;
}
sub SelectARef
{
my $self = shift;
my $data = $self->Select(@_);
return [] unless $data;
return [$data] unless ref($data) eq 'ARRAY';
return $data;
}
sub getLastInsertId
{
return shift->{ dbh }->{'mysql_insertid'};
}