[LON-CAPA-cvs] cvs: nsdl / lonsql
www
lon-capa-cvs@mail.lon-capa.org
Fri, 28 Jul 2006 17:55:19 -0000
This is a MIME encoded message
--www1154109319
Content-Type: text/plain
www Fri Jul 28 13:55:19 2006 EDT
Modified files:
/nsdl lonsql
Log:
Backport all the good stuff between 1.67 and 1.77 of the real lonsql
--www1154109319
Content-Type: text/plain
Content-Disposition: attachment; filename="www-20060728135519.txt"
Index: nsdl/lonsql
diff -u nsdl/lonsql:1.10 nsdl/lonsql:1.11
--- nsdl/lonsql:1.10 Tue Nov 29 16:02:52 2005
+++ nsdl/lonsql Fri Jul 28 13:55:18 2006
@@ -1,9 +1,9 @@
#!/usr/bin/perl
# The LearningOnline Network
-# lonsql - LON TCP-NSDL Query Handler.
+# lonsql - LON TCP-MySQL-Server Daemon for handling database requests.
#
-# $Id: lonsql,v 1.10 2005/11/29 21:02:52 www Exp $
+# $Id: lonsql,v 1.11 2006/07/28 17:55:18 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -102,6 +102,7 @@
use strict;
use lib '/home/httpd/lib/perl/';
+use LONCAPA;
use LONCAPA::Configuration;
use LONCAPA::lonmetadata();
@@ -113,13 +114,36 @@
use Socket;
use Fcntl;
use Tie::RefHash;
-use HTML::LCParser();
-use LWP::UserAgent();
-use HTTP::Headers;
-use HTTP::Date;
+use DBI;
use File::Find;
use localenroll;
+# FOR NSDL
+
+ use HTML::LCParser();
+ use LWP::UserAgent();
+ use HTTP::Headers;
+ use HTTP::Date;
+
+########################################################
+########################################################
+
+=pod
+
+=item Global Variables
+
+=over 4
+
+=item dbh
+
+=back
+
+=cut
+
+########################################################
+########################################################
+my $dbh;
+
########################################################
########################################################
@@ -207,6 +231,29 @@
#
+# 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";
+ my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
+ my $subj="LON: $perlvar{'lonHostID'} Cannot connect to database!";
+ system("echo 'Cannot connect to MySQL database!' |".
+ " mailto $emailto -s '$subj' > /dev/null");
+
+ open(SMP,'>/home/httpd/html/lon-status/mysql.txt');
+ print SMP 'time='.time.'&mysql=defunct'."\n";
+ close(SMP);
+
+ exit 1;
+} else {
+ unlink('/home/httpd/html/lon-status/mysql.txt');
+ $dbh->disconnect;
+}
+
+#
# Check if other instance running
#
my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";
@@ -221,12 +268,14 @@
# Read hosts file
#
my $thisserver;
+my %hostname;
my $PREFORK=4; # number of children to maintain, at least four spare
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
while (my $configline=<CONFIG>) {
my ($id,$domain,$role,$name)=split(/:/,$configline);
$name=~s/\s//g;
$thisserver=$name if ($id eq $perlvar{'lonHostID'});
+ $hostname{$id}=$name;
#$PREFORK++;
}
close(CONFIG);
@@ -325,7 +374,20 @@
# unblock signals
sigprocmask(SIG_UNBLOCK, $sigset)
or die "Can't unblock SIGINT for fork: $!\n";
-
+ #open database handle
+ # making dbh global to avoid garbage collector
+ unless ($dbh = DBI->connect("DBI:mysql:loncapa","www",
+ $perlvar{'lonSqlAccess'},
+ { RaiseError =>0,PrintError=>0})) {
+ sleep(10+int(rand(20)));
+ &logthis("<font color='blue'>WARNING: Couldn't connect to database".
+ ": $@</font>");
+ # "($st secs): $@</font>");
+ print "database handle error\n";
+ exit;
+ }
+ # make sure that a database disconnection occurs with
+ # ending kill signals
$SIG{TERM}=$SIG{INT}=$SIG{QUIT}=$SIG{__DIE__}=\&DISCONNECT;
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD
for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
@@ -334,6 +396,8 @@
$run = $run+1;
my $userinput = <$client>;
chomp($userinput);
+ $userinput=~s/\:(\w+)$//;
+ my $searchdomain=$1;
#
my ($conserver,$query,
$arg1,$arg2,$arg3)=split(/&/,$userinput);
@@ -371,7 +435,8 @@
$result='no_such_file';
}
# end of log query
- } elsif ($query eq 'fetchenrollment') {
+ } elsif (($query eq 'fetchenrollment') ||
+ ($query eq 'institutionalphotos')) {
# retrieve institutional class lists
my $dom = &unescape($arg1);
my %affiliates = ();
@@ -383,7 +448,18 @@
@{$affiliates{$1}} = split/,/,$2;
}
}
- $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies);
+ if ($query eq 'fetchenrollment') {
+ $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies);
+ } elsif ($query eq 'institutionalphotos') {
+ my $crs = &unescape($arg2);
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ $locresult = &localenroll::institutional_photos($dom,$crs,\%affiliates,\%replies,'update');
+ };
+ if ($@) {
+ $locresult = 'error';
+ }
+ }
$result = &escape($locresult.':');
if ($locresult) {
$result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies));
@@ -404,7 +480,7 @@
}
} else {
# Do an sql query
- $result = &nsdl_query($query,$arg1,$arg2);
+ $result = &nsdl_query($query,$arg1,$arg2,$searchdomain);
}
# result does not need to be escaped because it has already been
# escaped.
@@ -413,13 +489,96 @@
}
# tidy up gracefully and finish
#
-
+ # close the database handle
+ $dbh->disconnect
+ or &logthis("<font color='blue'>WARNING: Couldn't disconnect".
+ " from database $DBI::errstr : $@</font>");
# this exit is VERY important, otherwise the child will become
# a producer of more and more children, forking yourself into
# process death.
exit;
}
}
+
+
+########################################################
+########################################################
+
+#
+# Takes SQL query
+# sends it to NSDL
+#
+
+sub nsdl_query {
+ my $query=shift;
+ my ($keyword)=($query=~/\"\%([^\%]+)\%\"/);
+ $keyword=&escape($keyword);
+ my $url='http://search.nsdl.org?verb=Search&s=0&n=500&q=-link.primaryCollection:oai\:nsdl.org\:nsdl.nsdl\:00254%20'.$keyword;
+ my $ua=new LWP::UserAgent;
+ my $response=$ua->get($url);
+ my $parser=HTML::LCParser->new(\$response->content);
+ my $is='';
+ my $cont='';
+ my $token;
+ my %result=();
+ my $allresults='';
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'T') {
+ $cont.=$token->[1];
+ } elsif ($token->[0] eq 'S') {
+ if ($token->[1] eq 'record') {
+ %result=();
+ } elsif ($token->[1]=~/^dc\:/) {
+ $is=$token->[1];
+ $cont='';
+ }
+ } elsif ($token->[0] eq 'E') {
+ if ($token->[1] eq 'record') {
+#
+# Now store it away
+#
+ my $url=$result{'dc:identifier'};
+ if ($url=~/^http\:/) {
+ $url=~s/^http:\//\/ext/;
+ } else {
+ $url='';
+ }
+ if ($url) {
+ my ($mime)=($url=~/\.(\w+)$/);
+ $mime=~tr/A-Z/a-z/;
+ my $createdate=$result{'dc:date'};
+ if ($createdate) {
+ unless ($createdate=~/\:\d+$/) {
+ $createdate.=' 00:00:00';
+ }
+ }
+ unless ($createdate=~/^\d+\-\d+\-\d+\s+\d+\:\d+\:\d+$/) {
+ $createdate='';
+ }
+ $createdate=&escape($createdate);
+
+ $allresults.='&'.
+ &escape($result{'dc:title'}).','.
+ &escape($result{'dc:creator'}).','.
+ &escape($result{'dc:subject'}).','.
+ &escape($url).',,,,'.
+ &escape($result{'dc:description'}).','.
+ &escape($mime).',seniso,'.$createdate.','.$createdate.','.&escape('public@nsdl').
+ ',public,nsdl,,,,,,,,,,,,,,,,,,,,,,,,,,,,';
+ }
+ %result=();
+ } elsif ($token->[1]=~/^dc\:/) {
+ $result{$is}=$cont;
+ }
+ }
+ }
+ $allresults=~s/^\&//;
+
+ return $allresults;
+}
+
+
+########################################################
########################################################
=pod
@@ -466,12 +625,12 @@
########################################################
sub subreply {
my ($cmd,$server)=@_;
- my $peerfile="$perlvar{'lonSockDir'}/$server";
+ my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server};
my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile",
Type => SOCK_STREAM,
Timeout => 10)
or return "con_lost";
- print $sclient "$cmd\n";
+ print $sclient "sethost:$server:$cmd\n";
my $answer=<$sclient>;
chomp($answer);
$answer="con_lost" if (!$answer);
@@ -516,52 +675,6 @@
=pod
-=item &escape
-
-Escape special characters in a string.
-
-Inputs: string to escape
-
-Returns: The input string with special characters escaped.
-
-=cut
-
-########################################################
-########################################################
-sub escape {
- my $str=shift;
- $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
- return $str;
-}
-
-########################################################
-########################################################
-
-=pod
-
-=item &unescape
-
-Unescape special characters in a string.
-
-Inputs: string to unescape
-
-Returns: The input string with special characters unescaped.
-
-=cut
-
-########################################################
-########################################################
-sub unescape {
- my $str=shift;
- $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
- return $str;
-}
-
-########################################################
-########################################################
-
-=pod
-
=item &ishome
Determine if the current machine is the home server for a user.
@@ -790,79 +903,14 @@
exec("$execdir/lonsql"); # here we go again
}
-#
-# Takes SQL query
-# sends it to NSDL
-#
-
-sub nsdl_query {
- my $query=shift;
- my ($keyword)=($query=~/\"\%([^\%]+)\%\"/);
- $keyword=&escape($keyword);
- my $url='http://search.nsdl.org?verb=Search&s=0&n=500&q=-link.primaryCollection:oai\:nsdl.org\:nsdl.nsdl\:00254%20'.$keyword;
- my $ua=new LWP::UserAgent;
- my $response=$ua->get($url);
- my $parser=HTML::LCParser->new(\$response->content);
- my $is='';
- my $cont='';
- my $token;
- my %result=();
- my $allresults='';
- while ($token=$parser->get_token) {
- if ($token->[0] eq 'T') {
- $cont.=$token->[1];
- } elsif ($token->[0] eq 'S') {
- if ($token->[1] eq 'record') {
- %result=();
- } elsif ($token->[1]=~/^dc\:/) {
- $is=$token->[1];
- $cont='';
- }
- } elsif ($token->[0] eq 'E') {
- if ($token->[1] eq 'record') {
-#
-# Now store it away
-#
- my $url=$result{'dc:identifier'};
- if ($url=~/^http\:/) {
- $url=~s/^http:\//\/ext/;
- } else {
- $url='';
- }
- if ($url) {
- my ($mime)=($url=~/\.(\w+)$/);
- $mime=~tr/A-Z/a-z/;
- my $createdate=$result{'dc:date'};
- if ($createdate) {
- unless ($createdate=~/\:\d+$/) {
- $createdate.=' 00:00:00';
- }
- }
- unless ($createdate=~/^\d+\-\d+\-\d+\s+\d+\:\d+\:\d+$/) {
- $createdate='';
- }
- $createdate=&escape($createdate);
-
- $allresults.='&'.
- &escape($result{'dc:title'}).','.
- &escape($result{'dc:creator'}).','.
- &escape($result{'dc:subject'}).','.
- &escape($url).',,,,'.
- &escape($result{'dc:description'}).','.
- &escape($mime).',seniso,'.$createdate.','.$createdate.','.&escape('public@nsdl').
- ',public,nsdl,,,,,,,,,,,,,,,,,,,,,,,,,,,,';
- }
- %result=();
- } elsif ($token->[1]=~/^dc\:/) {
- $result{$is}=$cont;
- }
- }
- }
- $allresults=~s/^\&//;
-
- return $allresults;
+sub DISCONNECT {
+ $dbh->disconnect or
+ &logthis("<font color='blue'>WARNING: Couldn't disconnect from database ".
+ " $DBI::errstr : $@</font>");
+ exit;
}
+
=pod
=back
--www1154109319--