#!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; my $page = slurpfile($folder."profiles/settings_pm.html"); $page .= ""; 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||; $pro_list .=qq|$_->{name}  |; } $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 .= ""; 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 .= "
[*] TERMINAL CONFIGURATION EDITOR | Folder: \\SPACEPOS_STATIONS
"; #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 .= "Success: an empty station configuration has been added for $R::newip
"; } else { $temphtml .= "Error: the required station ($R::newip) is already existing
"; } } else { $temphtml .= "Error: the specified station IP ($R::newip) is invalid
"; } } 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.
" if (! -d "/SPACEPOS_STATIONS/$R::station"); $temphtml .= "ERROR: There is a problem deleting the files in /SPACEPOS_STATIONS/$R::station/
Please perform a manual folder removal.

" 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 .= "Settings for station $ip successfuly saved.
"; } 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 .= "Configured stations:
    "; $temphtml .= ""; foreach my $ip (@stations) { $temphtml .= " " : " 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 .= "
  • $ip Nickname: $nickname | [edit station] [delete station]
    (Till ID: $till_id | Server IP: $host | Cashdrawer Port: $cashdrawerdev)
    "; $temphtml .= "
  • "; 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 .= "
    "; $temphtml .= "
      "; $temphtml .= ""; $temphtml .= "
      SPACE POS SETTINGS
      "; $temphtml .= ""; while ($settingsfile =~ /\&(.*?)=(.*?)\&/sgi) { $temphtml .= ""; } $temphtml .= "
      $1:
      "; $temphtml .= "
      "; $temphtml .= "WINDOWS PRINTERS
      "; for (1..7) { $temphtml .= "
      "; } $temphtml .= "
      Station Nickname:
    "; } } $temphtml .= "
    "; $temphtml .= "
    New Station IP : Nickname: "; $temphtml .= ""; #$temphtml .= ""; $temphtml .= "
"; $template =~ s/\%content\%/$temphtml/; #-------------------------------------------------------------------------------------- } elsif ($R::action eq 'printers') { my $page = ''; #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 "Error deleting Queue Directory for $ip:$que. Close POS Server"; } } 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 "Error creating Queue Directory for $ip:$que"; } } 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 .= "Alternative printer created."; } else { $page .= "Provide all fields please."; } } elsif ($R::command eq "delete_alt_printer") { if ($R::tillid and $R::oldorder) { $page .= "Alternative printer deleted."; delete $printsetup_pm{altord}{$R::tillid}{$R::oldorder}; store \%printsetup_pm, '/wwwroot/extranet/printsetup_pm.sto'; } } #/commands $page .= "
"; $page .= "

"; $page .= "
"; $page .= "Defined LPD Printers (physical printers and existing LPD queues):
"; foreach my $key ( sort {$a cmp $b} keys %{ $printsetup_pm{prntype} } ) { $page .= "
  • $key (Type: ".( $printsetup_pm{prntype}{$key} == 1 ? "epson" : "non-epson"); $page .= ") [X]"; } $page .= "
    Queue Name: (eg. 127.0.0.1/kitchen)
    (Epson ? )
    "; $page .= "
    "; $page .= "SpacePOS Till and Order Printers (used in PLU editor):
    "; foreach my $key ( sort {$a cmp $b} keys %{ $printsetup_pm{psubst} } ) { $page .= "
  • $key "; $page .= " STATION " if ($key =~ /^T/); $page .= " [add destination] [X]"; $page .= "
      "; my $cnt =0; foreach my $skey (@{ $printsetup_pm{psubst}{$key} }) { $page .= "
    • $skey [X]"; $cnt ++; $page .= " Error!" if (! exists $printsetup_pm{prntype}{$skey}); } if ( ($R::command eq "add_to_opd") and ($key eq $R::opd_name) ) { $page .= ""; $page .= "
    • "; } $page .= "
    "; } $page .= " "; $page . "
  • "; $page .= "
    "; $page .= "ORDER PRINTERS REDIRECTION RULES
    "; $page .= "
      "; #{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 .= "
    • Orders placed from station ID $shopid for $oldorder will be redirected to $printsetup_pm{altord}{$shopid}{$oldorder} [X]
      "; } } $page .= "
    "; $page .= " Station Number (ID): Order Printer: Alternative Order Printer:
    "; $page .= "
    "; $page .= "
  • "; $page .= "
    "; $page .= ""; $page .= ""; $template =~ s/\%content\%/$page/; #-------------------------------------------------------------------------------------- } elsif ($R::action eq 'dbcreate') { my $page = ''; $page .= "
    "; $page .= "

    "; $page .= "
    "; 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.
    VERY IMPORTANT NOTE
    (please print this short instruction)
    Please specify
  • Stock Types,
  • Stock Categories,
  • Stock Items,
  • PLU Categories,
  • Components,products
  • PLU Items
    and then link the products to the PLU Items
    "; } my $existing = 1; my $results = $dbh->prepare("show tables from $db;") or die $dbh->errstr(); $results->execute() or $existing = 0; $page .= "
    "; $page .= "Current configuration is using database $db
    "; $page .= "$db is ".( $existing == 1 ? "existing" : "not existing."); if ($existing != 1) { $page .= "
    Mysql Data: "; $page .= "
    New Database Name: "; $page .= "

    "; } $page .= "
    "; } else { $page .= "Error: Unable to connect to MySQL Server. Please make sure that it is running and there is no missing files."; } $page .= "
  • "; $page .= "
    "; $page .= ""; $page .= ""; $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'}; }