--- loncom/lonsql 2001/03/27 13:35:35 1.21 +++ loncom/lonsql 2001/04/02 20:16:31 1.30 @@ -23,7 +23,18 @@ sub wanted { push(@metalist,"$dir/$_"); } - +{ + my $dbh; + unless ( + $dbh = DBI->connect("DBI:mysql:loncapa","www","123",{ RaiseError =>0,PrintError=>0}) + ) { + print "Cannot connect to database!\n"; + exit; + } + else { + $dbh->disconnect; + } +} $childmaxattempts=10; $run =0;#running counter to generate the query-id @@ -193,10 +204,9 @@ sub make_new_child { unless ( $dbh = DBI->connect("DBI:mysql:loncapa","www","123",{ 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; }; @@ -225,31 +235,36 @@ 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; my @files; - 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); + 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); + } } - # do custom metadata searching here and build into result - if ($custom) { + if ($custom or $customshow) { &logthis("am going to do custom query for $custom"); - if (@files) { - @metalist=map {$perlvar{'lonDocRoot'}.$_.'meta'} @files; + if ($query) { + @metalist=map {$perlvar{'lonDocRoot'}.$_.'.meta'} @files; } else { @metalist=(); pop @metalist; @@ -262,6 +277,7 @@ sub make_new_child { # 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>; @@ -274,11 +290,24 @@ sub make_new_child { $stuff=~s/\n?\<$f[^\>]*\>.*?<\/$f[^\>]*\>\n?//; } 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 '$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