--- loncom/lonsql 2004/08/20 16:42:41 1.64 +++ loncom/lonsql 2006/05/11 17:53:22 1.77 @@ -3,7 +3,7 @@ # The LearningOnline Network # lonsql - LON TCP-MySQL-Server Daemon for handling database requests. # -# $Id: lonsql,v 1.64 2004/08/20 16:42:41 matthew Exp $ +# $Id: lonsql,v 1.77 2006/05/11 17:53:22 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -102,6 +102,7 @@ the database. use strict; use lib '/home/httpd/lib/perl/'; +use LONCAPA; use LONCAPA::Configuration; use LONCAPA::lonmetadata(); @@ -241,6 +242,7 @@ unless ($dbh = DBI->connect("DBI:mysql:l exit 1; } else { + unlink('/home/httpd/html/lon-status/mysql.txt'); $dbh->disconnect; } @@ -258,20 +260,20 @@ if (-e $pidfile) { # # Read hosts file # -my %hostip; 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=) { - my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); - chomp($ip); - $hostip{$ip}=$id; + my ($id,$domain,$role,$name)=split(/:/,$configline); + $name=~s/\s//g; $thisserver=$name if ($id eq $perlvar{'lonHostID'}); - $PREFORK++; + $hostname{$id}=$name; + #$PREFORK++; } close(CONFIG); # -$PREFORK=int($PREFORK/4); +#$PREFORK=int($PREFORK/4); # # Create a socket to talk to lond @@ -387,6 +389,8 @@ sub make_new_child { $run = $run+1; my $userinput = <$client>; chomp($userinput); + $userinput=~s/\:(\w+)$//; + my $searchdomain=$1; # my ($conserver,$query, $arg1,$arg2,$arg3)=split(/&/,$userinput); @@ -424,7 +428,8 @@ sub make_new_child { $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 = (); @@ -432,11 +437,22 @@ sub make_new_child { my $locresult = ''; my $querystr = &unescape($arg3); foreach (split/%%/,$querystr) { - if (/^(\w+)=([^=]+)$/) { + if (/^([^=]+)=([^=]+)$/) { @{$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)); @@ -457,7 +473,7 @@ sub make_new_child { } } else { # Do an sql query - $result = &do_sql_query($query,$arg1,$arg2); + $result = &do_sql_query($query,$arg1,$arg2,$searchdomain); } # result does not need to be escaped because it has already been # escaped. @@ -508,8 +524,18 @@ sub process_file { } sub do_sql_query { - my ($query,$custom,$customshow) = @_; - &logthis('doing query '.$query); + my ($query,$custom,$customshow,$searchdomain) = @_; + +# +# limit to searchdomain if given and table is metadata +# + if (($searchdomain) && ($query=~/FROM metadata/)) { + $query.=' HAVING (domain="'.$searchdomain.'")'; + } +# &logthis('doing query ('.$searchdomain.')'.$query); + + + $custom = &unescape($custom); $customshow = &unescape($customshow); # @@ -653,12 +679,12 @@ Returns: The results of the message or ' ######################################################## 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); @@ -699,52 +725,6 @@ sub reply { } ######################################################## -######################################################## - -=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