--- loncom/lonsql 2001/03/22 16:10:53 1.8 +++ loncom/lonsql 2001/03/27 13:35:35 1.21 @@ -13,6 +13,16 @@ 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$/ && + push(@metalist,"$dir/$_"); +} + $childmaxattempts=10; $run =0;#running counter to generate the query-id @@ -202,9 +212,11 @@ sub make_new_child { my $userinput = <$client>; chomp($userinput); - my ($conserver,$querytmp,$customtmp)=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; @@ -216,6 +228,7 @@ sub make_new_child { #prepare and execute the query my $sth = $dbh->prepare($query); my $result; + my @files; unless ($sth->execute()) { &logthis("WARNING: Could not retrieve from database: $@"); @@ -223,14 +236,53 @@ sub make_new_child { } 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"; + my @r2; + map {my $a=$_; + my @b=map {escape($_)} @$a; + push @files,@{$a}[3]; + push @r2,join(",", @b) + } (@$r1); + $result=join("&",@r2); } # do custom metadata searching here and build into result - &logthis("am going to do custom query for $custom"); - + if ($custom) { + &logthis("am going to do custom query for $custom"); + if (@files) { + @metalist=map {$perlvar{'lonDocRoot'}.$_.'meta'} @files; + } + else { + @metalist=(); pop @metalist; + &find("$perlvar{'lonDocRoot'}/res"); + } +# &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=''; + 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$//; +# &logthis("found: $stuff"); + $customresult.='&custom='.escape($m2).','.escape($stuff); + } + } + $result.=$customresult; + } # reply with result + $result.="\n" if $result; &reply("queryreply:$queryid:$result",$conserver); }