Return to lonsql CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lonsql between versions 1.2 and 1.4

version 1.2, 2000/06/26 02:42:42	version 1.4, 2000/07/25 16:06:57
Line 1	Line 1
#!/usr/bin/perl	#!/usr/bin/perl
# lonsql-based on the preforker:harsha jagasia:date:5/10/00	# lonsql-based on the preforker:harsha jagasia:date:5/10/00
	# 7/25 Gerd Kortemeyer

use IO::Socket;	use IO::Socket;
use Symbol;	use Symbol;
Line 27 while ($configline=<CONFIG>) {	Line 28 while ($configline=<CONFIG>) {
}	}
close(CONFIG);	close(CONFIG);

	# --------------------------------------------- Check if other instance running

	my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";

	if (-e $pidfile) {
	my $lfh=IO::File->new("$pidfile");
	my $pide=<$lfh>;
	chomp($pide);
	if (kill 0 => $pide) { die "already running"; }
	}

# ------------------------------------------------------------- Read hosts file	# ------------------------------------------------------------- Read hosts file
$PREFORK=4; # number of children to maintain, at least four spare	$PREFORK=4; # number of children to maintain, at least four spare

Line 168 sub make_new_child {	Line 180 sub make_new_child {
#open database handle	#open database handle
# making dbh global to avoid garbage collector	# making dbh global to avoid garbage collector
unless (	unless (
$dbh = DBI->connect("DBI:mysql:loncapa","www","newmysql",{ RaiseError =>1,})	$dbh = DBI->connect("DBI:mysql:loncapa","www","newmysql",{ RaiseError =>0,PrintError=>0})
) {	) {
my $st=120+int(rand(240));	my $st=120+int(rand(240));
&logthis("<font color=blue>WARNING: Couldn't connect to database ($st secs): $@</font>");	&logthis("<font color=blue>WARNING: Couldn't connect to database ($st secs): $@</font>");
Line 189 sub make_new_child {	Line 201 sub make_new_child {
my $userinput = <$client>;	my $userinput = <$client>;
chomp($userinput);	chomp($userinput);

my ($conserver,$query)=split(/&/,$userinput);	my ($conserver,$querytmp)=split(/&/,$userinput);
	my $query=unescape($querytmp);

#send query id which is pid_unixdatetime_runningcounter	#send query id which is pid_unixdatetime_runningcounter
$queryid = $thisserver;	$queryid = $thisserver;
Line 199 sub make_new_child {	Line 212 sub make_new_child {
print $client "$queryid\n";	print $client "$queryid\n";

#prepare and execute the query	#prepare and execute the query
# my $sth = $dbh->prepare($query);	my $sth = $dbh->prepare($query);
# unless ($sth->execute())	my $result;
# {	unless ($sth->execute())
# &logthis(	{
# "<font color=blue>WARNING: Could not retrieve from database: $@</font>"	&logthis("<font color=blue>WARNING: Could not retrieve from database: $@</font>");
# );	$result="";
# }	}
# my $result=$sth->fetch(???);	else {
$result="123";	my $r1=$sth->fetchall_arrayref;
	my @r2; map {my $a=$_; my @b=map {escape($_)} @$a; push @r2,join(",", @b)} (@$r1);
	$result=join("&",@r2) . "\n";
	}
&reply("queryreply:$queryid:$result",$conserver);	&reply("queryreply:$queryid:$result",$conserver);

}	}
Line 262 sub reply {	Line 278 sub reply {
return $answer;	return $answer;
}	}

	# -------------------------------------------------------- Escape Special Chars

	sub escape {
	my $str=shift;
	$str =~ s/(\W)/"%".unpack('H2',$1)/eg;
	return $str;
	}

	# ----------------------------------------------------- Un-Escape Special Chars

	sub unescape {
	my $str=shift;
	$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
	return $str;
	}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

Removed from v.1.2
changed lines
	Added in v.1.4