#!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>&nbsp;&nbsp;|;
									}
			                        
								 
									$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'};
}