loncom/lonsql - diff

Return to lonsql CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lonsql between versions 1.21 and 1.39

version 1.21, 2001/03/27 13:35:35	version 1.39, 2001/11/29 13:53:56
Line 1	Line 1
#!/usr/bin/perl	#!/usr/bin/perl

	# The LearningOnline Network
	# lonsql - LON TCP-MySQL-Server
	#
	# YEAR=2000
# 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	# 7/25 Gerd Kortemeyer
# many different dates Scott Harrison	# many different dates Scott Harrison
	# YEAR=2001
	# many different dates Scott Harrison
# 03/22/2001 Scott Harrison	# 03/22/2001 Scott Harrison
	# 8/30 Gerd Kortemeyer
	# 10/17,11/28,11/29 Scott Harrison
	#
	# $Id$
	###


use IO::Socket;	use IO::Socket;
use Symbol;	use Symbol;
use POSIX;	use POSIX;
Line 19 require "find.pl";	Line 33 require "find.pl";
sub wanted {	sub wanted {
(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&	(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
-f _ &&	-f _ &&
/^.*\.meta$/ &&	/^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ &&
push(@metalist,"$dir/$_");	push(@metalist,"$dir/$_");
}	}


$childmaxattempts=10;	$childmaxattempts=10;
$run =0;#running counter to generate the query-id	$run =0;#running counter to generate the query-id

Line 39 while ($configline=<CONFIG>) {	Line 52 while ($configline=<CONFIG>) {
}	}
close(CONFIG);	close(CONFIG);

	# ------------------------------------- Make sure that database can be accessed
	{
	my $dbh;
	unless (
	$dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
	) {
	print "Cannot connect to database!\n";
	$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
	$subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";
	system("echo 'Cannot connect to MySQL database!' \|\
	mailto $emailto -s '$subj' > /dev/null");
	exit 1;
	}
	else {
	$dbh->disconnect;
	}
	}

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

my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";	my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";
Line 60 while ($configline=<CONFIG>) {	Line 91 while ($configline=<CONFIG>) {
chomp($ip);	chomp($ip);

$hostip{$ip}=$id;	$hostip{$ip}=$id;

if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }	if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }

$PREFORK++;	$PREFORK++;
}	}
close(CONFIG);	close(CONFIG);

	$PREFORK=int($PREFORK/4);

$unixsock = "mysqlsock";	$unixsock = "mysqlsock";
my $localfile="$perlvar{'lonSockDir'}/$unixsock";	my $localfile="$perlvar{'lonSockDir'}/$unixsock";
my $server;	my $server;
Line 191 sub make_new_child {	Line 223 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","123",{ RaiseError =>0,PrintError=>0})	$dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
) {	) {
my $st=120+int(rand(240));	sleep(10+int(rand(20)));
&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>");
print "database handle error\n";	print "database handle error\n";
sleep($st);
exit;	exit;

};	};
Line 225 sub make_new_child {	Line 256 sub make_new_child {
$queryid .= $run;	$queryid .= $run;
print $client "$queryid\n";	print $client "$queryid\n";

	&logthis("QUERY: $query");
	&logthis("QUERY: $query");
	sleep 1;
#prepare and execute the query	#prepare and execute the query
my $sth = $dbh->prepare($query);	my $sth = $dbh->prepare($query);
my $result;	my $result;
my @files;	my @files;
unless ($sth->execute())	my $subsetflag=0;
{	if ($query) {
&logthis("<font color=blue>WARNING: Could not retrieve from database: $@</font>");	unless ($sth->execute())
$result="";	{
}	&logthis("<font color=blue>WARNING: Could not retrieve from database: $@</font>");
else {	$result="";
my $r1=$sth->fetchall_arrayref;	}
my @r2;	else {
map {my $a=$_;	my $r1=$sth->fetchall_arrayref;
my @b=map {escape($_)} @$a;	my @r2;
push @files,@{$a}[3];	map {my $a=$_;
push @r2,join(",", @b)	my @b=map {escape($_)} @$a;
} (@$r1);	push @files,@{$a}[3];
$result=join("&",@r2);	push @r2,join(",", @b)
	} (@$r1);
	$result=join("&",@r2);
	}
}	}

# do custom metadata searching here and build into result	# do custom metadata searching here and build into result
if ($custom) {	if ($custom or $customshow) {
&logthis("am going to do custom query for $custom");	&logthis("am going to do custom query for $custom");
if (@files) {	if ($query) {
@metalist=map {$perlvar{'lonDocRoot'}.$_.'meta'} @files;	@metalist=map {$perlvar{'lonDocRoot'}.$_.'.meta'} @files;
}	}
else {	else {
@metalist=(); pop @metalist;	@metalist=(); pop @metalist;
&find("$perlvar{'lonDocRoot'}/res");	opendir(RESOURCES,"$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}");
	my @homeusers=grep
	{&ishome("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$_")}
	grep {!/^\.\.?$/} readdir(RESOURCES);
	closedir RESOURCES;
	foreach my $user (@homeusers) {
	&find("$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}/$user");
	}
}	}
# &logthis("FILELIST:" . join(":::",@metalist));	# &logthis("FILELIST:" . join(":::",@metalist));
# if file is indicated in sql database and	# if file is indicated in sql database and
Line 262 sub make_new_child {	Line 305 sub make_new_child {
# if file is indicated in sql database and is	# if file is indicated in sql database and is
# part of query result list, then do the pattern match.	# part of query result list, then do the pattern match.
my $customresult='';	my $customresult='';
	my @r2;
foreach my $m (@metalist) {	foreach my $m (@metalist) {
my $fh=IO::File->new($m);	my $fh=IO::File->new($m);
my @lines=<$fh>;	my @lines=<$fh>;
Line 271 sub make_new_child {	Line 315 sub make_new_child {
'creationdate','keywords','language',	'creationdate','keywords','language',
'lastrevisiondate','mime','notes',	'lastrevisiondate','mime','notes',
'owner','subject','title') {	'owner','subject','title') {
$stuff=~s/\n?\<$f[^\>]\>.?<\/$f[^\>]*\>\n?//;	$stuff=~s/\n?\<$f[^\>]\>.?<\/$f[^\>]*\>\n?//s;
}	}
my $m2=$m; my $docroot=$perlvar{'lonDocRoot'};	my $m2=$m; my $docroot=$perlvar{'lonDocRoot'};
$m2=~s/^$docroot//; $m2=~s/\.meta$//;	$m2=~s/^$docroot//;
	$m2=~s/\.meta$//;
	unless ($query) {
	my $q2="select * from metadata where url like binary '$m2'";
	my $sth = $dbh->prepare($q2);
	$sth->execute();
	my $r1=$sth->fetchall_arrayref;
	map {my $a=$_;
	my @b=map {escape($_)} @$a;
	push @files,@{$a}[3];
	push @r2,join(",", @b)
	} (@$r1);
	}
# &logthis("found: $stuff");	# &logthis("found: $stuff");
$customresult.='&custom='.escape($m2).','.escape($stuff);	$customresult.='&custom='.escape($m2).','.escape($stuff);
}	}
}	}
	$result=join("&",@r2) unless $query;
$result.=$customresult;	$result.=$customresult;
}	}
# reply with result	# reply with result
Line 333 sub reply {	Line 390 sub reply {
}	}
} else {	} else {
$answer='self_reply';	$answer='self_reply';
	$answer=subreply($cmd,$server);
}	}
return $answer;	return $answer;
}	}
Line 352 sub unescape {	Line 410 sub unescape {
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;	$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
return $str;	return $str;
}	}

	# --------------------------------------- Is this the home server of an author?
	# (copied from lond, modification of the return value)
	sub ishome {
	my $author=shift;
	$author=~s/\/home\/httpd\/html\/res\/([^\/])\/([^\/]).*/$1\/$2/;
	my ($udom,$uname)=split(/\//,$author);
	my $proname=propath($udom,$uname);
	if (-e $proname) {
	return 1;
	} else {
	return 0;
	}
	}

	# -------------------------------------------- Return path to profile directory
	# (copied from lond)
	sub propath {
	my ($udom,$uname)=@_;
	$udom=~s/\W//g;
	$uname=~s/\W//g;
	my $subdir=$uname.'__';
	$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
	my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
	return $proname;
	}

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

Removed from v.1.21
changed lines
	Added in v.1.39