--- nsdl/lonsql 2005/09/26 19:00:29 1.1 +++ nsdl/lonsql 2005/11/17 22:51:59 1.4 @@ -1,9 +1,9 @@ #!/usr/bin/perl # The LearningOnline Network -# lonsql - LON TCP-MySQL-Server Daemon for handling database requests. +# lonsql - LON TCP-NSDL Query Handler. # -# $Id: lonsql,v 1.1 2005/09/26 19:00:29 www Exp $ +# $Id: lonsql,v 1.4 2005/11/17 22:51:59 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -113,32 +113,16 @@ use IO::File; use Socket; use Fcntl; use Tie::RefHash; -use DBI; +use HTML::LCParser(); +use LWP::UserAgent(); +use HTTP::Headers; +use HTTP::Date; use File::Find; use localenroll; ######################################################## ######################################################## -=pod - -=item Global Variables - -=over 4 - -=item dbh - -=back - -=cut - -######################################################## -######################################################## -my $dbh; - -######################################################## -######################################################## - =pod =item Variables required for forking @@ -223,29 +207,6 @@ ENDMYCNF # -# 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"; @@ -364,20 +325,7 @@ sub make_new_child { # 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("WARNING: Couldn't connect to database". - ": $@"); - # "($st secs): $@"); - 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++) { @@ -431,7 +379,7 @@ sub make_new_child { my $locresult = ''; my $querystr = &unescape($arg3); foreach (split/%%/,$querystr) { - if (/^(\w+)=([^=]+)$/) { + if (/^([^=]+)=([^=]+)$/) { @{$affiliates{$1}} = split/,/,$2; } } @@ -465,10 +413,7 @@ sub make_new_child { } # tidy up gracefully and finish # - # close the database handle - $dbh->disconnect - or &logthis("WARNING: Couldn't disconnect". - " from database $DBI::errstr : $@"); + # this exit is VERY important, otherwise the child will become # a producer of more and more children, forking yourself into # process death. @@ -507,101 +452,22 @@ sub process_file { } sub do_sql_query { - my ($query,$custom,$customshow) = @_; + my ($query) = @_; &logthis('doing query '.$query); - $custom = &unescape($custom); - $customshow = &unescape($customshow); - # - @metalist = (); - # - my $result = ''; + my @results = (); - my @files; - my $subsetflag=0; + # if ($query) { #prepare and execute the query - my $sth = $dbh->prepare($query); - unless ($sth->execute()) { - &logthis(''. - 'WARNING: Could not retrieve from database:'. - $sth->errstr().''); - } else { - my $aref=$sth->fetchall_arrayref; - foreach my $row (@$aref) { - push @files,@{$row}[3] if ($custom or $customshow); - my @b=map { &escape($_); } @$row; - push @results,join(",", @b); - # Build up the @files array with the LON-CAPA urls - # of the resources. - } - } - } - # do custom metadata searching here and build into result - return join("&",@results) if (! ($custom or $customshow)); - # Only get here if there is a custom query or custom show request - &logthis("Doing custom query for $custom"); - if ($query) { - @metalist=map { - $perlvar{'lonDocRoot'}.$_.'.meta'; - } @files; - } else { - my $dir = "$perlvar{'lonDocRoot'}/res/$perlvar{'lonDefDomain'}"; - @metalist=(); - opendir(RESOURCES,$dir); - my @homeusers=grep { - &ishome($dir.'/'.$_); - } grep {!/^\.\.?$/} readdir(RESOURCES); - closedir RESOURCES; - # Define the - foreach my $user (@homeusers) { - find (\&process_file,$dir.'/'.$user); - } - } - # 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 @results; - foreach my $metafile (@metalist) { - my $fh=IO::File->new($metafile); - 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?//s; - } - my $mfile=$metafile; - my $docroot=$perlvar{'lonDocRoot'}; - $mfile=~s/^$docroot//; - $mfile=~s/\.meta$//; - unless ($query) { - my $q2="SELECT * FROM metadata WHERE url ". - " LIKE BINARY '?'"; - my $sth = $dbh->prepare($q2); - $sth->execute($mfile); - my $aref=$sth->fetchall_arrayref; - foreach my $a (@$aref) { - my @b=map { &escape($_)} @$a; - push @results,join(",", @b); - } - } - # &logthis("found: $stuff"); - $customresult.='&custom='.&escape($mfile).','. - escape($stuff); - } + my $aref=&nsdl_query($query); + foreach my $row (@$aref) { + my @b=map { &escape($_); } @$row; + push @results,join(",", @b); + } + } - $result=join("&",@results) unless $query; - $result.=$customresult; - # - return $result; + return join("&",@results); } # End of &do_sql_query } # End of scoping curly braces for &process_file and &do_sql_query @@ -976,14 +842,49 @@ sub HUPSMAN { # sig exec("$execdir/lonsql"); # here we go again } -sub DISCONNECT { - $dbh->disconnect or - &logthis("WARNING: Couldn't disconnect from database ". - " $DBI::errstr : $@"); - exit; +# +# Takes SQL query +# sends it to NSDL +# has to return array reference +# + +sub nsdl_query { + my $query=shift; + my ($keyword)=($query=~/\"\%([^\%]+)\%\"/); + $keyword=&escape($keyword); + &logthis('Doing '.$keyword); + my $url='http://search.nsdl.org?verb=Search&s=0&n=500&q='.$keyword; + my $ua=new LWP::UserAgent; + my $response=$ua->get($url); + my $parser=HTML::LCParser->new(\$response->content); + my %result=(); + my $is=(); + my $cont=''; + my $array=[]; + my $token; + 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 +# + } elsif ($token->[1]=/^dc\:/) { + $result{$is}=$cont; + } + } + } + return $array; } - =pod =back