pQmars/qcw-prod/cli-srv/bin qcw-server.pl,NONE,1.1

[alexander sasha wait]

Update of /cvsroot/corewar/pQmars/qcw-prod/cli-srv/bin
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25631/qcw-prod/cli-srv/bin

Added Files:
qcw-server.pl
Log Message:
start */qcw-server.pl


--- NEW FILE: qcw-server.pl ---
#! /usr/bin/perl -w

use strict;

use Getopt::Std;

use DBI;

my %args;
getopts ("mrs", \%args);

my $mysql_srv = $ENV{"COREWORLD_MYSQL_SERVER"};
my $mysql_db = $ENV{"COREWORLD_MYSQL_DB"};
my $mysql_uid = $ENV{"COREWORLD_MYSQL_USER"};
my $mysql_pw = $ENV{"COREWORLD_MYSQL_PASSWORD"};
my $qcw_bin = $ENV{"COREWORLD_BIN"};

my $dbh = DBI->connect ("DBI:mysql:$mysql_db:$mysql_srv",
$mysql_uid,
$mysql_pw,
{ RaiseError => 1, AutoCommit =>0 }) ||
die "Database connection not made: $DBI::errstr";

if ($args{m}) {
md5sums();
}
elsif ($args{r}) {
run();
}
elsif ($args{s}) {
stop();
}
else {
default();
}

$dbh->disconnect;

sub default {

my $var = "+";

for (my $i = 1; $i <= 30; $i++) {
$var = $var.$var;
my $j = 2**$i;
print "$j\n";
}

my $sql = qq{ CREATE TABLE admin ( id INT NOT NULL AUTO_INCREMENT,
pid INT NOT NULL,
text LONGTEXT NOT NULL,
PRIMARY KEY (id)) };
eval {
$dbh->do ($sql);
$dbh->commit();
};

if ($@) {
print "$@\n";
$dbh->rollback();
}
print "$$ is running.\n";
}



sub md5sums {
print "Verifying md5sums in qcw table\n";

my $sth = $dbh->prepare("SELECT * FROM `qcw`");
$sth->execute();

while (my @row = $sth->fetchrow_array) {
print "***$row[0]***$row[1]***$row[2]***$row[4]***$row[5]\n";

open SPOOLER, "| tar -jOxf - | bzcat | zcat | md5sum"
or die "can't spool $!";

print SPOOLER $row[3];

close SPOOLER;
}
$sth->finish;
}

sub run {
print "Checking for runable Coreworld...\n";

my $sth = $dbh->prepare("SELECT * FROM `qcw` where `lock`=1");
$sth->execute();

my $i=0;
my $world;

while (my @row = $sth->fetchrow_array) {
$world = $row[3];
$i++;
}
$sth->finish;
if ($i == 1) {

pQmars();

for (my $j = 1; $j <= 4; $j++) {

my $cell = sprintf("%8.8X.qcw.gz.bz2",$j);

open SPOOLER, "| tar -Ojxf - $cell |bzcat|zcat|head"
or die "can't spool $!";

print SPOOLER $world;

close SPOOLER
or die "can't close spool $!";

}

}
else {
print "Table corruption couldn't run...\n";
}
}



sub pQmars {

my $pid;
return if $pid = open(STDOUT, "|-");
die "cannot fork: $!" unless defined $pid;

undef $/;
my $qcw = <STDIN>;

print "$qcw\n!!!Caught the output!!!\n";

exit;
}