package prnelem; use me; use strict; no strict "refs"; use CGI; use CGI::Session; use DBI; use Apache::DBI; use Data::Dumper; use CGI::Session::Driver::mysql; use Template; use lib '/wwwroot/extranet/'; my $q = new CGI; $q->import("R"); print $q->header(); our $VAR1; our $sessiondir = '/wwwsessions'; my $tdir = "/wwwroot/extranet/tvis"; our $dbuser = 'root'; our $dbpassword = 'fbg4ips'; our $dbhost = '127.0.0.1'; our $database; our %shop; my %tilltabletype =(1=>"RESTAURANT",2=>"BAR",3=>"RETAIL",4=>"STAFFPROMO",5=>"BREAKFAST",6=>"GARDEN",7=>"STOEP",20=>"CASHPOINT"); sub prnelem { #################### SESSION ####################### $q = new CGI; $q->import_names('R'); #retreive cookie CGI::Session->name("CGISESSIDSPACEBIZ"); my $session ; my $dbhs; $dbhs = DBI->connect("DBI:mysql:backoffice;host=127.0.0.1",'root','fbg4ips') or die $DBI::errstr; $session = new CGI::Session("driver:mysql;serializer:storable;", $q, {Handle=>$dbhs}) || die "$!"; #logininit($session,$q); my $login_cookie = $q->cookie(-name=>"CGISESSIDSPACEBIZ"); if ($login_cookie) { $session->clear(["~logged-in"]) if $login_cookie ne $session->id(); } else { $session->clear(["~logged-in"]) } my %cookies = fetch CGI::Cookie; my $store_session_cookie = $q->cookie(-name=>"CGISESSIDSPACEBIZ",-value => $session->id(),-expires => "+365d" ); #print $R::remember; my $logexp = 0; my $login_session_cookie = $q->cookie(-name=>"LOG_CGISESSIDSPACEBIZ",-value => $session->id(),-expires => $logexp); print $q->header(-cookie => [$store_session_cookie,$login_session_cookie]); ################### / SESSION ###################### if ( $session->param("~logged-in") ) { my $profile = $session->param("~profile"); $database = $profile->{database}; my $dbh = DBI->connect("DBI:mysql:$database;host=127.0.0.1",'root','fbg4ips') or die $DBI::errstr; #LET's load settings from database to overwrite sto files my $settings_pm = $session->param("~settings_pm"); my $sys_settings; foreach (split(/:/,$settings_pm)){ my($k,$v) = split(/=/); $sys_settings->{$k} = $v; } settings->new($sys_settings); our $thisshop = $settings::shop_id; #/superuser = 0 our $abrevi = $settings::abrev; #/shop abreviature $shop{id} = $settings::shop_id; logit("ShopID:".$shop{id} . "\n$thisshop\n$abrevi\nEND\n"); #start normal operation my $profile = $session->param("~profile"); my $username = $profile->{username}; my $usertype = $profile->{type}; $database = $profile->{database}; logit("Database:$database\n"); my ($results, $subresults, $subresults1, $ref,$ref1,$ref2,$subref,$subref1) = undef; if (! $R::action) { my $some_dir = "$tdir/elems"; opendir(DD, $some_dir) || die "can't opendir $some_dir: $!"; my @read = sort {$a cmp $b} grep { $_ !~ /^\./ && $_ =~ /(bmp|png|jpg|gif)$/i } readdir(DD); closedir(DD); my $table_dir = "$tdir/tables_elems"; opendir(DD, $table_dir) || die "can't opendir $some_dir: $!"; my @tblz = sort {$a cmp $b} grep { $_ !~ /^\./ && $_ =~ /(bmp|png|jpg|gif)$/i } readdir(DD); closedir(DD); my $file = "$tdir/tables.html"; my $vars = {}; my $output; $_ = qq~"$_"~ foreach @tblz; $vars->{tab_elems} = join(",",@tblz); foreach my $src (sort {$a cmp $b} @read) { $vars->{images} .= qq~
~; } $vars->{images} .= qq~
Text
~; $vars->{images} .= qq~
Text
~; $vars->{images} .= qq~
Text
~; $vars->{images} .= qq~
Text
~; $vars->{images} .= qq~
Text
~; $vars->{images} .= qq~
Text
~; my $data = eval(tvis_readtmp($database)); my $first = 1; if (keys %{ $data->{stages} }) { $vars->{sceneselect} =qq~ ~; } else { $vars->{thislayout} = $R::stagename; } $vars->{thislayout} = "RESTAURANT" if ($vars->{thislayout} eq ''); #$data->{stages}->{$R::stagename}->{tables}->{$nr} my %tableusage; foreach my $scene (sort {$a cmp $b} keys %{ $data->{stages} }) { foreach my $tablenumber (keys %{ $data->{stages}->{$scene}->{tables} }) { $tableusage{$tablenumber} = $scene; } } $results = $dbh->prepare(" select * from tilltables where active=1 and f_status < 100 order by ordering,number ;") or die $dbh->errstr(); $results->execute() or die $results->errstr(); while ($ref = $results->fetchrow_hashref()) { if (exists $tableusage{$ref->{number}} and $tableusage{$ref->{number}} eq $vars->{thislayout} ) { #used here $vars->{tables} .= qq~ {number}")>
$ref->{number}
~; } elsif (exists $tableusage{$ref->{number}} and $tableusage{$ref->{number}} ne $vars->{thislayout} ) { $vars->{tables} .= qq~
$ref->{number}
~; } else { # table not on layout $vars->{tables} .= qq~ {number}")>
$ref->{number}
~; } } ### LOAD SCENE ### my $xoffset = 270; my $yoffset = 49; $vars->{totalelements} = (sort {$b <=> $a} keys %{$data->{stages}->{$vars->{thislayout}}->{elems}})[0] || 0; $vars->{totaltexts} = (sort {$b <=> $a} keys %{$data->{stages}->{$vars->{thislayout}}->{txts}})[0] || 0; foreach my $ind ( sort {$a <=> $b} keys %{$data->{stages}->{$vars->{thislayout}}->{elems}}) { my $chunk = $data->{stages}->{$vars->{thislayout}}->{elems}->{$ind}; my $onmousedown = qq~onmousedown="startDrag('$chunk->{pic}^$ind',event)"~; $chunk->{cx} += $xoffset; $chunk->{cy} += $yoffset; $vars->{loader} .= qq~~; $vars->{loader} .= qq~~; $vars->{loader} .= qq~~; $vars->{initialelements} .= " '$chunk->{pic}^$ind' : '$chunk->{pic}', "; } foreach my $ind ( sort {$a <=> $b} keys %{$data->{stages}->{$vars->{thislayout}}->{txts}}) { my $chunk = $data->{stages}->{$vars->{thislayout}}->{txts}->{$ind}; my $onmousedown = qq~onmousedown="startDrag('txt_$ind',event)"~; $chunk->{cx} += $xoffset; $chunk->{cy} += $yoffset; $vars->{loader} .= qq~~; $vars->{loader} .= qq~
$chunk->{txt}
~; $vars->{loader} .= qq~
~; $vars->{initialtexts} .= " '$ind' : '$chunk->{style}', "; } foreach my $ind ( sort {$a <=> $b} keys %{$data->{stages}->{$vars->{thislayout}}->{tables}}) { my $chunk = $data->{stages}->{$vars->{thislayout}}->{tables}->{$ind}; my $onmousedown = qq~onmousedown="startDrag('$ind',event)"~; $chunk->{cx} += $xoffset; $chunk->{cy} += $yoffset; $vars->{loader} .= qq~~; $vars->{loader} .= qq~~; $vars->{loader} .= qq~
$ind
~; $vars->{loader} .= qq~
~; $vars->{tablesshowing} .= " '$ind' : '1',"; $vars->{tablespics} .= " '$ind' : '$chunk->{pic}',"; $vars->{tableselementindex} .= "'$ind' : '1',"; #to fix } my $template = Template->new(ABSOLUTE => 1,COMPILE_EXT => '.ttc'); my $temphtml = $template->process($file, $vars, \$output)|| die "Template process failed: ", $template->error(), "\n"; print $output; } elsif ($R::action eq "rename") { my $data; $data = eval(tvis_readtmp($database)); $data->{stages}->{$R::name} = $data->{stages}->{$R::stagename}; delete $data->{stages}->{$R::stagename}; tvis_writetmp(Dumper($data), $database); print qq~GB_mess('Server Updated.');window.location='index.cgi?stagename=$R::name'~; } elsif ($R::action eq "save") { my $data; $data = eval(tvis_readtmp($database)); delete $data->{stages}->{$R::stagename}; if($R::elemz) { my @elz = split(']', $R::elemz); $_ =~ s/^\[// foreach @elz; $_ =~ s/\]$// foreach @elz; foreach my $line (@elz) { my ($pic,$ind,$cx,$cy) = split(/\^/,$line); $data->{stages}->{$R::stagename}->{elems}->{$ind}->{pic} = $pic; $data->{stages}->{$R::stagename}->{elems}->{$ind}->{cx} = $cx; $data->{stages}->{$R::stagename}->{elems}->{$ind}->{cy} = $cy; } } if($R::tblz) { my @elz = split(']', $R::tblz); $_ =~ s/^\[// foreach @elz; $_ =~ s/\]$// foreach @elz; foreach my $line (@elz) { my ($nr,$pic,$cx,$cy) = split(/\^/,$line); $data->{stages}->{$R::stagename}->{tables}->{$nr}->{pic} = $pic; $data->{stages}->{$R::stagename}->{tables}->{$nr}->{cx} = $cx; $data->{stages}->{$R::stagename}->{tables}->{$nr}->{cy} = $cy; } } if($R::txtz) { my @elz = split(']', $R::txtz); $_ =~ s/^\[// foreach @elz; $_ =~ s/\]$// foreach @elz; foreach my $line (@elz) { my ($nr,$txt,$style,$cx,$cy) = split(/\^/,$line); $data->{stages}->{$R::stagename}->{txts}->{$nr}->{txt} = $txt; $data->{stages}->{$R::stagename}->{txts}->{$nr}->{style} = $style; $data->{stages}->{$R::stagename}->{txts}->{$nr}->{cx} = $cx; $data->{stages}->{$R::stagename}->{txts}->{$nr}->{cy} = $cy; } } logit(Dumper($data)."---". $database); tvis_writetmp(Dumper($data), $database); print qq~GB_mess('Server Updated.');window.location='index.cgi?stagename=$R::stagename'~; } } else { #login failed my $profile = $session->param("~profile"); my $username = $profile->{username}; logit("Failed\n"); login_page($username); } } #### TEMP PROCEDURES ### sub tvis_writetmp { my $data = $_[0]; my $file = $_[1]; open (OUT, ">/wwwroot/extranet/tvis/data/$file") || die "$!"; print OUT $data; close OUT; } sub tvis_removetmp { my $file = $_[0]; unlink "/wwwroot/extranet/tvis/data/$file"; } sub tvis_readtmp { my $file = $_[0]; my $data = slurpfile("/wwwroot/extranet/tvis/data/$file"); return $data; } =pre #### LOGIN PROCEDURES #### sub logininit { my ($session, $cgi) = @_; # receive two args $session->clear(["~logged-in"]) if $cgi->param("cmd") eq "logout" ; return 1 if $session->param("~logged-in") ; # 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:;host=$dbhost",$dbuser,$dbpassword) or die $DBI::errstr; my $results = $dbh->prepare(" select * from spaceusers.users where username=? and password=?; ;") or die $dbh->errstr(); $results->execute($lg_name, $lg_psswd) or die $results->errstr(); my $ref = $results->fetchrow_hashref(); if ( $ref->{username} ) { return { userid=>$ref->{id}, username=>$lg_name, type=>$ref->{type} }; } else { #incorrect login page message. return undef; } } =cut ########################################################## sub login_page { my $username = $_[0]; my $file = "$tdir/login.html"; print "" } ########################################################### sub slurpfile { open(IN, "< $_[0]"); # or die "can't open $_[0]: $!"; #doesn't need to return error because some files don't exist binmode (IN); seek(IN, 0, 0); sysread (IN, my $slurp, -s IN); close(IN); return $slurp; } sub logit{ return; #trun it off globally my ($year,$month,$day,$hour,$minute,$second) = getTime(); open FILE,">>$tdir/prnelem.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 settings; sub new { my ($class,$sys_settings) = @_; my $self; foreach my $key(keys %{$sys_settings}){ ${$key} = $sys_settings->{$key}; } ${'tablesep'} = 1; return $self; } sub DESTROY { my $self = shift; } 1; =pod This script is sharing sessions with /extrent/index.pm =cut