nsdl/lonsql - view

File: [LON-CAPA] / nsdl / lonsql
Revision 1.4: download - view: text, annotated - select for diffs
Thu Nov 17 22:51:59 2005 UTC (18 years, 5 months ago) by www
Branches: MAIN
CVS tags: HEAD

Starting to parse output

1: #!/usr/bin/perl 2: 3: # The LearningOnline Network 4: # lonsql - LON TCP-NSDL Query Handler. 5: # 6: # $Id: lonsql,v 1.4 2005/11/17 22:51:59 www Exp $ 7: # 8: # Copyright Michigan State University Board of Trustees 9: # 10: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 11: # 12: # LON-CAPA is free software; you can redistribute it and/or modify 13: # it under the terms of the GNU General Public License as published by 14: # the Free Software Foundation; either version 2 of the License, or 15: # (at your option) any later version. 16: # 17: # LON-CAPA is distributed in the hope that it will be useful, 18: # but WITHOUT ANY WARRANTY; without even the implied warranty of 19: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20: # GNU General Public License for more details. 21: # 22: # You should have received a copy of the GNU General Public License 23: # along with LON-CAPA; if not, write to the Free Software 24: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 25: # 26: # /home/httpd/html/adm/gpl.txt 27: # 28: # http://www.lon-capa.org/ 29: # 30: 31: =pod 32: 33: =head1 NAME 34: 35: lonsql - LON TCP-MySQL-Server Daemon for handling database requests. 36: 37: =head1 SYNOPSIS 38: 39: This script should be run as user=www. 40: Note that a lonsql.pid file contains the pid of the parent process. 41: 42: =head1 OVERVIEW 43: 44: =head2 Purpose within LON-CAPA 45: 46: LON-CAPA is meant to distribute A LOT of educational content to A LOT 47: of people. It is ineffective to directly rely on contents within the 48: ext2 filesystem to be speedily scanned for on-the-fly searches of 49: content descriptions. (Simply put, it takes a cumbersome amount of 50: time to open, read, analyze, and close thousands of files.) 51: 52: The solution is to index various data fields that are descriptive of 53: the educational resources on a LON-CAPA server machine in a 54: database. Descriptive data fields are referred to as "metadata". The 55: question then arises as to how this metadata is handled in terms of 56: the rest of the LON-CAPA network without burdening client and daemon 57: processes. 58: 59: The obvious solution, using lonc to send a query to a lond process, 60: doesn't work so well in general as you can see in the following 61: example: 62: 63: lonc= loncapa client process A-lonc= a lonc process on Server A 64: lond= loncapa daemon process 65: 66: database command 67: A-lonc --------TCP/IP----------------> B-lond 68: 69: The problem emerges that A-lonc and B-lond are kept waiting for the 70: MySQL server to "do its stuff", or in other words, perform the 71: conceivably sophisticated, data-intensive, time-sucking database 72: transaction. By tying up a lonc and lond process, this significantly 73: cripples the capabilities of LON-CAPA servers. 74: 75: The solution is to offload the work onto another process, and use 76: lonc and lond just for requests and notifications of completed 77: processing: 78: 79: database command 80: 81: A-lonc ---------TCP/IP-----------------> B-lond =====> B-lonsql 82: <---------------------------------/ | 83: "ok, I'll get back to you..." | 84: | 85: / 86: A-lond <------------------------------- B-lonc <====== 87: "Guess what? I have the result!" 88: 89: Of course, depending on success or failure, the messages may vary, but 90: the principle remains the same where a separate pool of children 91: processes (lonsql's) handle the MySQL database manipulations. 92: 93: Thus, lonc and lond spend effectively no time waiting on results from 94: the database. 95: 96: =head1 Internals 97: 98: =over 4 99: 100: =cut 101: 102: use strict; 103: 104: use lib '/home/httpd/lib/perl/'; 105: use LONCAPA::Configuration; 106: use LONCAPA::lonmetadata(); 107: 108: use IO::Socket; 109: use Symbol; 110: use POSIX; 111: use IO::Select; 112: use IO::File; 113: use Socket; 114: use Fcntl; 115: use Tie::RefHash; 116: use HTML::LCParser(); 117: use LWP::UserAgent(); 118: use HTTP::Headers; 119: use HTTP::Date; 120: use File::Find; 121: use localenroll; 122: 123: ######################################################## 124: ######################################################## 125: 126: =pod 127: 128: =item Variables required for forking 129: 130: =over 4 131: 132: =item $MAX_CLIENTS_PER_CHILD 133: 134: The number of clients each child should process. 135: 136: =item %children 137: 138: The keys to %children are the current child process IDs 139: 140: =item $children 141: 142: The current number of children 143: 144: =back 145: 146: =cut 147: 148: ######################################################## 149: ######################################################## 150: my $MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should process 151: my %children = (); # keys are current child process IDs 152: my $children = 0; # current number of children 153: 154: ################################################################### 155: ################################################################### 156: 157: =pod 158: 159: =item Main body of code. 160: 161: =over 4 162: 163: =item Read data from loncapa_apache.conf and loncapa.conf. 164: 165: =item Ensure we can access the database. 166: 167: =item Determine if there are other instances of lonsql running. 168: 169: =item Read the hosts file. 170: 171: =item Create a socket for lonsql. 172: 173: =item Fork once and dissociate from parent. 174: 175: =item Write PID to disk. 176: 177: =item Prefork children and maintain the population of children. 178: 179: =back 180: 181: =cut 182: 183: ################################################################### 184: ################################################################### 185: my $childmaxattempts=10; 186: my $run =0; # running counter to generate the query-id 187: # 188: # Read loncapa_apache.conf and loncapa.conf 189: # 190: my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); 191: my %perlvar=%{$perlvarref}; 192: # 193: # Write the /home/www/.my.cnf file 194: my $conf_file = '/home/www/.my.cnf'; 195: if (! -e $conf_file) { 196: if (open MYCNF, ">$conf_file") { 197: print MYCNF <<"ENDMYCNF"; 198: [client] 199: user=www 200: password=$perlvar{'lonSqlAccess'} 201: ENDMYCNF 202: close MYCNF; 203: } else { 204: warn "Unable to write $conf_file, continuing"; 205: } 206: } 207: 208: 209: # 210: # Check if other instance running 211: # 212: my $pidfile="$perlvar{'lonDaemons'}/logs/lonsql.pid"; 213: if (-e $pidfile) { 214: my $lfh=IO::File->new("$pidfile"); 215: my $pide=<$lfh>; 216: chomp($pide); 217: if (kill 0 => $pide) { die "already running"; } 218: } 219: 220: # 221: # Read hosts file 222: # 223: my $thisserver; 224: my $PREFORK=4; # number of children to maintain, at least four spare 225: open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; 226: while (my $configline=<CONFIG>) { 227: my ($id,$domain,$role,$name)=split(/:/,$configline); 228: $name=~s/\s//g; 229: $thisserver=$name if ($id eq $perlvar{'lonHostID'}); 230: #$PREFORK++; 231: } 232: close(CONFIG); 233: # 234: #$PREFORK=int($PREFORK/4); 235: 236: # 237: # Create a socket to talk to lond 238: # 239: my $unixsock = "mysqlsock"; 240: my $localfile="$perlvar{'lonSockDir'}/$unixsock"; 241: my $server; 242: unlink ($localfile); 243: unless ($server=IO::Socket::UNIX->new(Local =>"$localfile", 244: Type => SOCK_STREAM, 245: Listen => 10)) { 246: print "in socket error:$@\n"; 247: } 248: 249: # 250: # Fork once and dissociate 251: # 252: my $fpid=fork; 253: exit if $fpid; 254: die "Couldn't fork: $!" unless defined ($fpid); 255: POSIX::setsid() or die "Can't start new session: $!"; 256: 257: # 258: # Write our PID on disk 259: my $execdir=$perlvar{'lonDaemons'}; 260: open (PIDSAVE,">$execdir/logs/lonsql.pid"); 261: print PIDSAVE "$$\n"; 262: close(PIDSAVE); 263: &logthis("CRITICAL: ---------- Starting ----------"); 264: 265: # 266: # Ignore signals generated during initial startup 267: $SIG{HUP}=$SIG{USR1}='IGNORE'; 268: # Now we are on our own 269: # Fork off our children. 270: for (1 .. $PREFORK) { 271: make_new_child(); 272: } 273: 274: # 275: # Install signal handlers. 276: $SIG{CHLD} = \&REAPER; 277: $SIG{INT} = $SIG{TERM} = \&HUNTSMAN; 278: $SIG{HUP} = \&HUPSMAN; 279: 280: # 281: # And maintain the population. 282: while (1) { 283: sleep; # wait for a signal (i.e., child's death) 284: for (my $i = $children; $i < $PREFORK; $i++) { 285: make_new_child(); # top up the child pool 286: } 287: } 288: 289: ######################################################## 290: ######################################################## 291: 292: =pod 293: 294: =item &make_new_child 295: 296: Inputs: None 297: 298: Returns: None 299: 300: =cut 301: 302: ######################################################## 303: ######################################################## 304: sub make_new_child { 305: my $pid; 306: my $sigset; 307: # 308: # block signal for fork 309: $sigset = POSIX::SigSet->new(SIGINT); 310: sigprocmask(SIG_BLOCK, $sigset) 311: or die "Can't block SIGINT for fork: $!\n"; 312: # 313: die "fork: $!" unless defined ($pid = fork); 314: # 315: if ($pid) { 316: # Parent records the child's birth and returns. 317: sigprocmask(SIG_UNBLOCK, $sigset) 318: or die "Can't unblock SIGINT for fork: $!\n"; 319: $children{$pid} = 1; 320: $children++; 321: return; 322: } else { 323: # Child can *not* return from this subroutine. 324: $SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before 325: # unblock signals 326: sigprocmask(SIG_UNBLOCK, $sigset) 327: or die "Can't unblock SIGINT for fork: $!\n"; 328: 329: $SIG{TERM}=$SIG{INT}=$SIG{QUIT}=$SIG{__DIE__}=\&DISCONNECT; 330: # handle connections until we've reached $MAX_CLIENTS_PER_CHILD 331: for (my $i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { 332: my $client = $server->accept() or last; 333: # do something with the connection 334: $run = $run+1; 335: my $userinput = <$client>; 336: chomp($userinput); 337: # 338: my ($conserver,$query, 339: $arg1,$arg2,$arg3)=split(/&/,$userinput); 340: my $query=unescape($query); 341: # 342: #send query id which is pid_unixdatetime_runningcounter 343: my $queryid = $thisserver; 344: $queryid .="_".($$)."_"; 345: $queryid .= time."_"; 346: $queryid .= $run; 347: print $client "$queryid\n"; 348: # 349: # &logthis("QUERY: $query - $arg1 - $arg2 - $arg3"); 350: sleep 1; 351: # 352: my $result=''; 353: # 354: # At this point, query is received, query-ID assigned and sent 355: # back, $query eq 'logquery' will mean that this is a query 356: # against log-files 357: if (($query eq 'userlog') || ($query eq 'courselog')) { 358: # beginning of log query 359: my $udom = &unescape($arg1); 360: my $uname = &unescape($arg2); 361: my $command = &unescape($arg3); 362: my $path = &propath($udom,$uname); 363: if (-e "$path/activity.log") { 364: if ($query eq 'userlog') { 365: $result=&userlog($path,$command); 366: } else { 367: $result=&courselog($path,$command); 368: } 369: } else { 370: &logthis('Unable to do log query: '.$uname.'@'.$udom); 371: $result='no_such_file'; 372: } 373: # end of log query 374: } elsif ($query eq 'fetchenrollment') { 375: # retrieve institutional class lists 376: my $dom = &unescape($arg1); 377: my %affiliates = (); 378: my %replies = (); 379: my $locresult = ''; 380: my $querystr = &unescape($arg3); 381: foreach (split/%%/,$querystr) { 382: if (/^([^=]+)=([^=]+)$/) { 383: @{$affiliates{$1}} = split/,/,$2; 384: } 385: } 386: $locresult = &localenroll::fetch_enrollment($dom,\%affiliates,\%replies); 387: $result = &escape($locresult.':'); 388: if ($locresult) { 389: $result .= &escape(join(':',map{$_.'='.$replies{$_}} keys %replies)); 390: } 391: } elsif ($query eq 'prepare activity log') { 392: my ($cid,$domain) = map {&unescape($_);} ($arg1,$arg2); 393: &logthis('preparing activity log tables for '.$cid); 394: my $command = 395: qq{$perlvar{'lonDaemons'}/parse_activity_log.pl -course=$cid -domain=$domain}; 396: system($command); 397: &logthis($command); 398: my $returnvalue = $?>>8; 399: if ($returnvalue) { 400: $result = 'error: parse_activity_log.pl returned '. 401: $returnvalue; 402: } else { 403: $result = 'success'; 404: } 405: } else { 406: # Do an sql query 407: $result = &do_sql_query($query,$arg1,$arg2); 408: } 409: # result does not need to be escaped because it has already been 410: # escaped. 411: #$result=&escape($result); 412: &reply("queryreply:$queryid:$result",$conserver); 413: } 414: # tidy up gracefully and finish 415: # 416: 417: # this exit is VERY important, otherwise the child will become 418: # a producer of more and more children, forking yourself into 419: # process death. 420: exit; 421: } 422: } 423: 424: ######################################################## 425: ######################################################## 426: 427: =pod 428: 429: =item &do_sql_query 430: 431: Runs an sql metadata table query. 432: 433: Inputs: $query, $custom, $customshow 434: 435: Returns: A string containing escaped results. 436: 437: =cut 438: 439: ######################################################## 440: ######################################################## 441: { 442: my @metalist; 443: 444: sub process_file { 445: if ( -e $_ && # file exists 446: -f $_ && # and is a normal file 447: /\.meta$/ && # ends in meta 448: ! /^.+\.\d+\.[^\.]+\.meta$/ # is not a previous version 449: ) { 450: push(@metalist,$File::Find::name); 451: } 452: } 453: 454: sub do_sql_query { 455: my ($query) = @_; 456: &logthis('doing query '.$query); 457: 458: my @results = (); 459: 460: # 461: if ($query) { 462: #prepare and execute the query 463: my $aref=&nsdl_query($query); 464: foreach my $row (@$aref) { 465: my @b=map { &escape($_); } @$row; 466: push @results,join(",", @b); 467: } 468: 469: } 470: return join("&",@results); 471: } # End of &do_sql_query 472: 473: } # End of scoping curly braces for &process_file and &do_sql_query 474: ######################################################## 475: ######################################################## 476: 477: =pod 478: 479: =item &logthis 480: 481: Inputs: $message, the message to log 482: 483: Returns: nothing 484: 485: Writes $message to the logfile. 486: 487: =cut 488: 489: ######################################################## 490: ######################################################## 491: sub logthis { 492: my $message=shift; 493: my $execdir=$perlvar{'lonDaemons'}; 494: my $fh=IO::File->new(">>$execdir/logs/lonsql.log"); 495: my $now=time; 496: my $local=localtime($now); 497: print $fh "$local ($$): $message\n"; 498: } 499: 500: # -------------------------------------------------- Non-critical communication 501: 502: ######################################################## 503: ######################################################## 504: 505: =pod 506: 507: =item &subreply 508: 509: Sends a command to a server. Called only by &reply. 510: 511: Inputs: $cmd,$server 512: 513: Returns: The results of the message or 'con_lost' on error. 514: 515: =cut 516: 517: ######################################################## 518: ######################################################## 519: sub subreply { 520: my ($cmd,$server)=@_; 521: my $peerfile="$perlvar{'lonSockDir'}/$server"; 522: my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", 523: Type => SOCK_STREAM, 524: Timeout => 10) 525: or return "con_lost"; 526: print $sclient "$cmd\n"; 527: my $answer=<$sclient>; 528: chomp($answer); 529: $answer="con_lost" if (!$answer); 530: return $answer; 531: } 532: 533: ######################################################## 534: ######################################################## 535: 536: =pod 537: 538: =item &reply 539: 540: Sends a command to a server. 541: 542: Inputs: $cmd,$server 543: 544: Returns: The results of the message or 'con_lost' on error. 545: 546: =cut 547: 548: ######################################################## 549: ######################################################## 550: sub reply { 551: my ($cmd,$server)=@_; 552: my $answer; 553: if ($server ne $perlvar{'lonHostID'}) { 554: $answer=subreply($cmd,$server); 555: if ($answer eq 'con_lost') { 556: $answer=subreply("ping",$server); 557: $answer=subreply($cmd,$server); 558: } 559: } else { 560: $answer='self_reply'; 561: $answer=subreply($cmd,$server); 562: } 563: return $answer; 564: } 565: 566: ######################################################## 567: ######################################################## 568: 569: =pod 570: 571: =item &escape 572: 573: Escape special characters in a string. 574: 575: Inputs: string to escape 576: 577: Returns: The input string with special characters escaped. 578: 579: =cut 580: 581: ######################################################## 582: ######################################################## 583: sub escape { 584: my $str=shift; 585: $str =~ s/(\W)/"%".unpack('H2',$1)/eg; 586: return $str; 587: } 588: 589: ######################################################## 590: ######################################################## 591: 592: =pod 593: 594: =item &unescape 595: 596: Unescape special characters in a string. 597: 598: Inputs: string to unescape 599: 600: Returns: The input string with special characters unescaped. 601: 602: =cut 603: 604: ######################################################## 605: ######################################################## 606: sub unescape { 607: my $str=shift; 608: $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; 609: return $str; 610: } 611: 612: ######################################################## 613: ######################################################## 614: 615: =pod 616: 617: =item &ishome 618: 619: Determine if the current machine is the home server for a user. 620: The determination is made by checking the filesystem for the users information. 621: 622: Inputs: $author 623: 624: Returns: 0 - this is not the authors home server, 1 - this is. 625: 626: =cut 627: 628: ######################################################## 629: ######################################################## 630: sub ishome { 631: my $author=shift; 632: $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; 633: my ($udom,$uname)=split(/\//,$author); 634: my $proname=propath($udom,$uname); 635: if (-e $proname) { 636: return 1; 637: } else { 638: return 0; 639: } 640: } 641: 642: ######################################################## 643: ######################################################## 644: 645: =pod 646: 647: =item &propath 648: 649: Inputs: user name, user domain 650: 651: Returns: The full path to the users directory. 652: 653: =cut 654: 655: ######################################################## 656: ######################################################## 657: sub propath { 658: my ($udom,$uname)=@_; 659: $udom=~s/\W//g; 660: $uname=~s/\W//g; 661: my $subdir=$uname.'__'; 662: $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; 663: my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; 664: return $proname; 665: } 666: 667: ######################################################## 668: ######################################################## 669: 670: =pod 671: 672: =item &courselog 673: 674: Inputs: $path, $command 675: 676: Returns: unescaped string of values. 677: 678: =cut 679: 680: ######################################################## 681: ######################################################## 682: sub courselog { 683: my ($path,$command)=@_; 684: my %filters=(); 685: foreach (split(/\:/,&unescape($command))) { 686: my ($name,$value)=split(/\=/,$_); 687: $filters{$name}=$value; 688: } 689: my @results=(); 690: open(IN,$path.'/activity.log') or return ('file_error'); 691: while (my $line=<IN>) { 692: chomp($line); 693: my ($timestamp,$host,$log)=split(/\:/,$line); 694: # 695: # $log has the actual log entries; currently still escaped, and 696: # %26(timestamp)%3a(url)%3a(user)%3a(domain) 697: # then additionally 698: # %3aPOST%3a(name)%3d(value)%3a(name)%3d(value) 699: # or 700: # %3aCSTORE%3a(name)%3d(value)%26(name)%3d(value) 701: # 702: # get delimiter between timestamped entries to be &&& 703: $log=~s/\%26(\d+)\%3a/\&\&\&$1\%3a/g; 704: # now go over all log entries 705: foreach (split(/\&\&\&/,&unescape($log))) { 706: my ($time,$res,$uname,$udom,$action,@values)=split(/\:/,$_); 707: my $values=&unescape(join(':',@values)); 708: $values=~s/\&/\:/g; 709: $res=&unescape($res); 710: my $include=1; 711: if (($filters{'username'}) && ($uname ne $filters{'username'})) 712: { $include=0; } 713: if (($filters{'domain'}) && ($udom ne $filters{'domain'})) 714: { $include=0; } 715: if (($filters{'url'}) && ($res!~/$filters{'url'}/)) 716: { $include=0; } 717: if (($filters{'start'}) && ($time<$filters{'start'})) 718: { $include=0; } 719: if (($filters{'end'}) && ($time>$filters{'end'})) 720: { $include=0; } 721: if (($filters{'action'} eq 'view') && ($action)) 722: { $include=0; } 723: if (($filters{'action'} eq 'submit') && ($action ne 'POST')) 724: { $include=0; } 725: if (($filters{'action'} eq 'grade') && ($action ne 'CSTORE')) 726: { $include=0; } 727: if ($include) { 728: push(@results,($time<1000000000?'0':'').$time.':'.$res.':'. 729: $uname.':'.$udom.':'. 730: $action.':'.$values); 731: } 732: } 733: } 734: close IN; 735: return join('&',sort(@results)); 736: } 737: 738: ######################################################## 739: ######################################################## 740: 741: =pod 742: 743: =item &userlog 744: 745: Inputs: $path, $command 746: 747: Returns: unescaped string of values. 748: 749: =cut 750: 751: ######################################################## 752: ######################################################## 753: sub userlog { 754: my ($path,$command)=@_; 755: my %filters=(); 756: foreach (split(/\:/,&unescape($command))) { 757: my ($name,$value)=split(/\=/,$_); 758: $filters{$name}=$value; 759: } 760: my @results=(); 761: open(IN,$path.'/activity.log') or return ('file_error'); 762: while (my $line=<IN>) { 763: chomp($line); 764: my ($timestamp,$host,$log)=split(/\:/,$line); 765: $log=&unescape($log); 766: my $include=1; 767: if (($filters{'start'}) && ($timestamp<$filters{'start'})) 768: { $include=0; } 769: if (($filters{'end'}) && ($timestamp>$filters{'end'})) 770: { $include=0; } 771: if (($filters{'action'} eq 'log') && ($log!~/^Log/)) { $include=0; } 772: if (($filters{'action'} eq 'check') && ($log!~/^Check/)) 773: { $include=0; } 774: if ($include) { 775: push(@results,$timestamp.':'.$log); 776: } 777: } 778: close IN; 779: return join('&',sort(@results)); 780: } 781: 782: ######################################################## 783: ######################################################## 784: 785: =pod 786: 787: =item Functions required for forking 788: 789: =over 4 790: 791: =item REAPER 792: 793: REAPER takes care of dead children. 794: 795: =item HUNTSMAN 796: 797: Signal handler for SIGINT. 798: 799: =item HUPSMAN 800: 801: Signal handler for SIGHUP 802: 803: =item DISCONNECT 804: 805: Disconnects from database. 806: 807: =back 808: 809: =cut 810: 811: ######################################################## 812: ######################################################## 813: sub REAPER { # takes care of dead children 814: $SIG{CHLD} = \&REAPER; 815: my $pid = wait; 816: $children --; 817: &logthis("Child $pid died"); 818: delete $children{$pid}; 819: } 820: 821: sub HUNTSMAN { # signal handler for SIGINT 822: local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children 823: kill 'INT' => keys %children; 824: my $execdir=$perlvar{'lonDaemons'}; 825: unlink("$execdir/logs/lonsql.pid"); 826: &logthis("CRITICAL: Shutting down"); 827: $unixsock = "mysqlsock"; 828: my $port="$perlvar{'lonSockDir'}/$unixsock"; 829: unlink($port); 830: exit; # clean up with dignity 831: } 832: 833: sub HUPSMAN { # signal handler for SIGHUP 834: local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children 835: kill 'INT' => keys %children; 836: close($server); # free up socket 837: &logthis("CRITICAL: Restarting"); 838: my $execdir=$perlvar{'lonDaemons'}; 839: $unixsock = "mysqlsock"; 840: my $port="$perlvar{'lonSockDir'}/$unixsock"; 841: unlink($port); 842: exec("$execdir/lonsql"); # here we go again 843: } 844: 845: # 846: # Takes SQL query 847: # sends it to NSDL 848: # has to return array reference 849: # 850: 851: sub nsdl_query { 852: my $query=shift; 853: my ($keyword)=($query=~/\"\%([^\%]+)\%\"/); 854: $keyword=&escape($keyword); 855: &logthis('Doing '.$keyword); 856: my $url='http://search.nsdl.org?verb=Search&s=0&n=500&q='.$keyword; 857: my $ua=new LWP::UserAgent; 858: my $response=$ua->get($url); 859: my $parser=HTML::LCParser->new(\$response->content); 860: my %result=(); 861: my $is=(); 862: my $cont=''; 863: my $array=[]; 864: my $token; 865: while ($token=$parser->get_token) { 866: if ($token->[0] eq 'T') { 867: $cont.=$token->[1]; 868: } elsif ($token->[0] eq 'S') { 869: if ($token->[1] eq 'record') { 870: %result=(); 871: } elsif ($token->[1]=/^dc\:/) { 872: $is=$token->[1]; 873: $cont=''; 874: } 875: } elsif ($token->[0] eq 'E') { 876: if ($token->[1] eq 'record') { 877: # 878: # Now store it away 879: # 880: } elsif ($token->[1]=/^dc\:/) { 881: $result{$is}=$cont; 882: } 883: } 884: } 885: return $array; 886: } 887: 888: =pod 889: 890: =back 891: 892: =cut