--- loncom/lonsql 2000/07/02 04:01:56 1.3 +++ loncom/lonsql 2001/08/30 13:57:04 1.36 @@ -1,5 +1,9 @@ #!/usr/bin/perl # lonsql-based on the preforker:harsha jagasia:date:5/10/00 +# 7/25 Gerd Kortemeyer +# many different dates Scott Harrison +# 03/22/2001 Scott Harrison +# 8/30 Gerd Kortemeyer use IO::Socket; use Symbol; @@ -11,6 +15,15 @@ use Fcntl; use Tie::RefHash; use DBI; +my @metalist; +# ----------------- Code to enable 'find' subroutine listing of the .meta files +require "find.pl"; +sub wanted { + (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && + -f _ && + /^.*\.meta$/ && !/^.+\.\d+\.[^\.]+\.meta$/ && + push(@metalist,"$dir/$_"); +} $childmaxattempts=10; $run =0;#running counter to generate the query-id @@ -27,6 +40,31 @@ while ($configline=) { } 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"; + exit; + } + else { + $dbh->disconnect; + } +} + +# --------------------------------------------- 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 $PREFORK=4; # number of children to maintain, at least four spare @@ -37,13 +75,14 @@ while ($configline=) { chomp($ip); $hostip{$ip}=$id; - if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } $PREFORK++; } close(CONFIG); +$PREFORK=int($PREFORK/4); + $unixsock = "mysqlsock"; my $localfile="$perlvar{'lonSockDir'}/$unixsock"; my $server; @@ -168,12 +207,11 @@ sub make_new_child { #open database handle # making dbh global to avoid garbage collector unless ( - $dbh = DBI->connect("DBI:mysql:loncapa","www","newmysql",{ 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("WARNING: Couldn't connect to database ($st secs): $@"); print "database handle error\n"; - sleep($st); exit; }; @@ -189,8 +227,11 @@ sub make_new_child { my $userinput = <$client>; chomp($userinput); - my ($conserver,$querytmp)=split(/&/,$userinput); + my ($conserver,$querytmp, + $customtmp,$customshowtmp)=split(/&/,$userinput); my $query=unescape($querytmp); + my $custom=unescape($customtmp); + my $customshow=unescape($customshowtmp); #send query id which is pid_unixdatetime_runningcounter $queryid = $thisserver; @@ -199,19 +240,90 @@ sub make_new_child { $queryid .= $run; print $client "$queryid\n"; + &logthis("QUERY: $query"); + &logthis("QUERY: $query"); + sleep 1; #prepare and execute the query my $sth = $dbh->prepare($query); my $result; - unless ($sth->execute()) - { - &logthis("WARNING: Could not retrieve from database: $@"); - $result=""; + my @files; + my $subsetflag=0; + if ($query) { + unless ($sth->execute()) + { + &logthis("WARNING: Could not retrieve from database: $@"); + $result=""; + } + else { + my $r1=$sth->fetchall_arrayref; + my @r2; + map {my $a=$_; + my @b=map {escape($_)} @$a; + push @files,@{$a}[3]; + push @r2,join(",", @b) + } (@$r1); + $result=join("&",@r2); + } } - else { - my $r1=$sth->fetchall_arrayref; - my @r2; map {my $a=$_; my @b=map {escape($_)} @$a; push @r2,join(",", @b)} (@$r1); - $result=join("&",@r2) . "\n"; + # do custom metadata searching here and build into result + if ($custom or $customshow) { + &logthis("am going to do custom query for $custom"); + if ($query) { + @metalist=map {$perlvar{'lonDocRoot'}.$_.'.meta'} @files; + } + else { + @metalist=(); pop @metalist; + 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)); + # if file is indicated in sql database and + # not part of sql-relevant query, do not pattern match. + # if file is not in sql database, output error. + # if file is indicated in sql database and is + # part of query result list, then do the pattern match. + my $customresult=''; + my @r2; + foreach my $m (@metalist) { + my $fh=IO::File->new($m); + my @lines=<$fh>; + my $stuff=join('',@lines); + if ($stuff=~/$custom/s) { + foreach my $f ('abstract','author','copyright', + 'creationdate','keywords','language', + 'lastrevisiondate','mime','notes', + 'owner','subject','title') { + $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//; + } + my $m2=$m; my $docroot=$perlvar{'lonDocRoot'}; + $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"); + $customresult.='&custom='.escape($m2).','.escape($stuff); + } + } + $result=join("&",@r2) unless $query; + $result.=$customresult; } + # reply with result + $result.="\n" if $result; &reply("queryreply:$queryid:$result",$conserver); } @@ -262,6 +374,7 @@ sub reply { } } else { $answer='self_reply'; + $answer=subreply($cmd,$server); } return $answer; } @@ -281,3 +394,29 @@ sub unescape { $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; 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; +}