[LON-CAPA-cvs] cvs: loncom / lond

foxr lon-capa-cvs@mail.lon-capa.org
Mon, 23 Aug 2004 11:24:45 -0000


This is a MIME encoded message

--foxr1093260285
Content-Type: text/plain

foxr		Mon Aug 23 07:24:45 2004 EDT

  Modified files:              
    /loncom	lond 
  Log:
  Converted the following requests to hash dispatched handlers and did
  some more stylistic cleanup:
  addchat   - Add a chat item.
  getchat   - Get items from chat room.
  querysend - Send an asyncrhonous sql query.
  queryreply- Get notified of the completion of an sql query initiated via
              querysend.
  courseidput- Insert a course id in the course database.
  courseiddump- Dump the set of course ids.
  
  For chat functions and courseid functions, tested against output from
  prior lond.  For sql functions, tested by querying published problem database
  on lond, as well as by publishing new resources and querying for them.
  
  
  
--foxr1093260285
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20040823072445.txt"

Index: loncom/lond
diff -u loncom/lond:1.233 loncom/lond:1.234
--- loncom/lond:1.233	Wed Aug 18 13:43:05 2004
+++ loncom/lond	Mon Aug 23 07:24:45 2004
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.233 2004/08/18 17:43:05 foxr Exp $
+# $Id: lond,v 1.234 2004/08/23 11:24:45 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -57,7 +57,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.233 $'; #' stupid emacs
+my $VERSION='$Revision: 1.234 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -2696,6 +2696,286 @@
 
 }
 &register_handler("restore", \&restore_handler, 0,1,0);
+
+#
+#   Add a chat message to to a discussion board.
+#
+# Parameters:
+#    $cmd                - Request keyword.
+#    $tail               - Tail of the command. A colon separated list
+#                          containing:
+#                          cdom    - Domain on which the chat board lives
+#                          cnum    - Identifier of the discussion group.
+#                          post    - Body of the posting.
+#   $client              - Socket open on the client.
+# Returns:
+#   1    - Indicating caller should keep on processing.
+#
+# Side-effects:
+#   writes a reply to the client.
+#
+#
+sub send_chat_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    
+    my $userinput = "$cmd:$tail";
+
+    my ($cdom,$cnum,$newpost)=split(/\:/,$tail);
+    &chat_add($cdom,$cnum,$newpost);
+    &Reply($client, "ok\n", $userinput);
+
+    return 1;
+}
+&register_handler("chatsend", \&send_chat_handler, 0, 1, 0);
+#
+#   Retrieve the set of chat messagss from a discussion board.
+#
+#  Parameters:
+#    $cmd             - Command keyword that initiated the request.
+#    $tail            - Remainder of the request after the command
+#                       keyword.  In this case a colon separated list of
+#                       chat domain    - Which discussion board.
+#                       chat id        - Discussion thread(?)
+#                       domain/user    - Authentication domain and username
+#                                        of the requesting person.
+#   $client           - Socket open on the client program.
+# Returns:
+#    1     - continue processing
+# Side effects:
+#    Response is written to the client.
+#
+sub retrieve_chat_handler {
+    my ($cmd, $tail, $client) = @_;
+
+
+    my $userinput = "$cmd:$tail";
+
+    my ($cdom,$cnum,$udom,$uname)=split(/\:/,$tail);
+    my $reply='';
+    foreach (&get_chat($cdom,$cnum,$udom,$uname)) {
+	$reply.=&escape($_).':';
+    }
+    $reply=~s/\:$//;
+    &Reply($client, $reply."\n", $userinput);
+
+
+    return 1;
+}
+&register_handler("chatretr", \&retrieve_chat_handler, 0, 1, 0);
+
+#
+#  Initiate a query of an sql database.  SQL query repsonses get put in
+#  a file for later retrieval.  This prevents sql query results from
+#  bottlenecking the system.  Note that with loncnew, perhaps this is
+#  less of an issue since multiple outstanding requests can be concurrently
+#  serviced.
+#
+#  Parameters:
+#     $cmd       - COmmand keyword that initiated the request.
+#     $tail      - Remainder of the command after the keyword.
+#                  For this function, this consists of a query and
+#                  3 arguments that are self-documentingly labelled
+#                  in the original arg1, arg2, arg3.
+#     $client    - Socket open on the client.
+# Return:
+#    1   - Indicating processing should continue.
+# Side-effects:
+#    a reply is written to $client.
+#
+sub send_query_handler {
+    my ($cmd, $tail, $client) = @_;
+
+
+    my $userinput = "$cmd:$tail";
+
+    my ($query,$arg1,$arg2,$arg3)=split(/\:/,$tail);
+    $query=~s/\n*$//g;
+    &Reply($client, "". &sql_reply("$clientname\&$query".
+				"\&$arg1"."\&$arg2"."\&$arg3")."\n",
+	  $userinput);
+    
+    return 1;
+}
+&register_handler("querysend", \&send_query_handler, 0, 1, 0);
+
+#
+#   Add a reply to an sql query.  SQL queries are done asyncrhonously.
+#   The query is submitted via a "querysend" transaction.
+#   There it is passed on to the lonsql daemon, queued and issued to
+#   mysql.
+#     This transaction is invoked when the sql transaction is complete
+#   it stores the query results in flie and indicates query completion.
+#   presumably local software then fetches this response... I'm guessing
+#   the sequence is: lonc does a querysend, we ask lonsql to do it.
+#   lonsql on completion of the query interacts with the lond of our
+#   client to do a query reply storing two files:
+#    - id     - The results of the query.
+#    - id.end - Indicating the transaction completed. 
+#    NOTE: id is a unique id assigned to the query and querysend time.
+# Parameters:
+#    $cmd        - Command keyword that initiated this request.
+#    $tail       - Remainder of the tail.  In this case that's a colon
+#                  separated list containing the query Id and the 
+#                  results of the query.
+#    $client     - Socket open on the client.
+# Return:
+#    1           - Indicating that we should continue processing.
+# Side effects:
+#    ok written to the client.
+#
+sub reply_query_handler {
+    my ($cmd, $tail, $client) = @_;
+
+
+    my $userinput = "$cmd:$tail";
+
+    my ($cmd,$id,$reply)=split(/:/,$userinput); 
+    my $store;
+    my $execdir=$perlvar{'lonDaemons'};
+    if ($store=IO::File->new(">$execdir/tmp/$id")) {
+	$reply=~s/\&/\n/g;
+	print $store $reply;
+	close $store;
+	my $store2=IO::File->new(">$execdir/tmp/$id.end");
+	print $store2 "done\n";
+	close $store2;
+	&Reply($client, "ok\n", $userinput);
+    } else {
+	&Failure($client, "error: ".($!+0)
+		." IO::File->new Failed ".
+		"while attempting queryreply\n", $userinput);
+    }
+ 
+
+    return 1;
+}
+&register_handler("queryreply", \&reply_query_handler, 0, 1, 0);
+
+#
+#  Process the courseidput request.  Not quite sure what this means
+#  at the system level sense.  It appears a gdbm file in the 
+#  /home/httpd/lonUsers/$domain/nohist_courseids is tied and
+#  a set of entries made in that database.
+#
+# Parameters:
+#   $cmd      - The command keyword that initiated this request.
+#   $tail     - Tail of the command.  In this case consists of a colon
+#               separated list contaning the domain to apply this to and
+#               an ampersand separated list of keyword=value pairs.
+#   $client   - Socket open on the client.
+# Returns:
+#   1    - indicating that processing should continue
+#
+# Side effects:
+#   reply is written to the client.
+#
+sub put_course_id_handler {
+    my ($cmd, $tail, $client) = @_;
+
+
+    my $userinput = "$cmd:$tail";
+
+    my ($udom, $what) = split(/:/, $tail);
+    chomp($what);
+    my $now=time;
+    my @pairs=split(/\&/,$what);
+
+    my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
+    if ($hashref) {
+	foreach my $pair (@pairs) {
+	    my ($key,$value)=split(/=/,$pair);
+	    $hashref->{$key}=$value.':'.$now;
+	}
+	if (untie(%$hashref)) {
+	    &Reply($client, "ok\n", $userinput);
+	} else {
+	    &Failure( $client, "error: ".($!+0)
+		     ." untie(GDBM) Failed ".
+		     "while attempting courseidput\n", $userinput);
+	}
+    } else {
+	&Failure( $client, "error: ".($!+0)
+		 ." tie(GDBM) Failed ".
+		 "while attempting courseidput\n", $userinput);
+    }
+
+    return 1;
+}
+&register_handler("courseidput", \&put_course_id_handler, 0, 1, 0);
+
+#  Retrieves the value of a course id resource keyword pattern
+#  defined since a starting date.  Both the starting date and the
+#  keyword pattern are optional.  If the starting date is not supplied it
+#  is treated as the beginning of time.  If the pattern is not found,
+#  it is treatred as "." matching everything.
+#
+#  Parameters:
+#     $cmd     - Command keyword that resulted in us being dispatched.
+#     $tail    - The remainder of the command that, in this case, consists
+#                of a colon separated list of:
+#                 domain   - The domain in which the course database is 
+#                            defined.
+#                 since    - Optional parameter describing the minimum
+#                            time of definition(?) of the resources that
+#                            will match the dump.
+#                 description - regular expression that is used to filter
+#                            the dump.  Only keywords matching this regexp
+#                            will be used.
+#     $client  - The socket open on the client.
+# Returns:
+#    1     - Continue processing.
+# Side Effects:
+#   a reply is written to $client.
+sub dump_course_id_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$since,$description) =split(/:/,$tail);
+    if (defined($description)) {
+	$description=&unescape($description);
+    } else {
+	$description='.';
+    }
+    unless (defined($since)) { $since=0; }
+    my $qresult='';
+    my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
+    if ($hashref) {
+	while (my ($key,$value) = each(%$hashref)) {
+	    my ($descr,$lasttime,$inst_code);
+	    if ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) {
+		($descr,$inst_code,$lasttime)=($1,$2,$3);
+	    } else {
+		($descr,$lasttime) = split(/\:/,$value);
+	    }
+	    if ($lasttime<$since) { next; }
+	    if ($description eq '.') {
+		$qresult.=$key.'='.$descr.':'.$inst_code.'&';
+	    } else {
+		my $unescapeVal = &unescape($descr);
+		if (eval('$unescapeVal=~/\Q$description\E/i')) {
+		    $qresult.=$key.'='.$descr.':'.$inst_code.'&';
+		}
+	    }
+	}
+	if (untie(%$hashref)) {
+	    chop($qresult);
+	    &Reply($client, "$qresult\n", $userinput);
+	} else {
+	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+		    "while attempting courseiddump\n", $userinput);
+	}
+    } else {
+	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+		"while attempting courseiddump\n", $userinput);
+    }
+
+
+    return 1;
+}
+&register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
+#
 #
 #
 #---------------------------------------------------------------
@@ -2713,7 +2993,7 @@
     my $input = <$client>;
     chomp($input);
 
-    Debug("get_request: Request = $input\n");
+    &Debug("get_request: Request = $input\n");
 
     &status('Processing '.$clientname.':'.$input);
 
@@ -2812,152 +3092,8 @@
 #------------------- Commands not yet in spearate handlers. --------------
 
 
-
-# -------------------------------------------------------------------- chatsend
-   if ($userinput =~ /^chatsend/) {
-	if(isClient) {
-	    my ($cmd,$cdom,$cnum,$newpost)=split(/\:/,$userinput);
-	    &chatadd($cdom,$cnum,$newpost);
-	    print $client "ok\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# -------------------------------------------------------------------- chatretr
-    } elsif ($userinput =~ /^chatretr/) {
-	if(isClient) {
-	    my 
-		($cmd,$cdom,$cnum,$udom,$uname)=split(/\:/,$userinput);
-	    my $reply='';
-	    foreach (&getchat($cdom,$cnum,$udom,$uname)) {
-		$reply.=&escape($_).':';
-	    }
-	    $reply=~s/\:$//;
-	    print $client $reply."\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------- querysend
-    } elsif ($userinput =~ /^querysend/) {
-	if (isClient) {
-	    my ($cmd,$query,
-		$arg1,$arg2,$arg3)=split(/\:/,$userinput);
-	    $query=~s/\n*$//g;
-	    print $client "".
-		sqlreply("$clientname\&$query".
-			 "\&$arg1"."\&$arg2"."\&$arg3")."\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ------------------------------------------------------------------ queryreply
-    } elsif ($userinput =~ /^queryreply/) {
-	if(isClient) {
-	    my ($cmd,$id,$reply)=split(/:/,$userinput); 
-	    my $store;
-	    my $execdir=$perlvar{'lonDaemons'};
-	    if ($store=IO::File->new(">$execdir/tmp/$id")) {
-		$reply=~s/\&/\n/g;
-		print $store $reply;
-		close $store;
-		my $store2=IO::File->new(">$execdir/tmp/$id.end");
-		print $store2 "done\n";
-		close $store2;
-		print $client "ok\n";
-	    } else {
-		print $client "error: ".($!+0)
-		    ." IO::File->new Failed ".
-		    "while attempting queryreply\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ----------------------------------------------------------------- courseidput
-    } elsif ($userinput =~ /^courseidput/) {
-	if(isClient) {
-	    my ($cmd,$udom,$what)=split(/:/,$userinput);
-	    chomp($what);
-			$udom=~s/\W//g;
-	    my $proname=
-		"$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
-	    my $now=time;
-	    my @pairs=split(/\&/,$what);
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
-		foreach my $pair (@pairs) {
-		    my ($key,$descr,$inst_code)=split(/=/,$pair);
-		    $hash{$key}=$descr.':'.$inst_code.':'.$now;
-		}
-		if (untie(%hash)) {
-		    print $client "ok\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting courseidput\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting courseidput\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ---------------------------------------------------------------- courseiddump
-    } elsif ($userinput =~ /^courseiddump/) {
-	if(isClient) {
-	    my ($cmd,$udom,$since,$description)
-		=split(/:/,$userinput);
-	    if (defined($description)) {
-		$description=&unescape($description);
-	    } else {
-		$description='.';
-	    }
-	    unless (defined($since)) { $since=0; }
-	    my $qresult='';
-	    my $proname=
-		"$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
-		while (my ($key,$value) = each(%hash)) {
-		    my ($descr,$lasttime,$inst_code);
-		    if ($value =~ m/^([^\:]*):([^\:]*):(\d+)$/) {
-			($descr,$inst_code,$lasttime)=($1,$2,$3);
-		    } else {
-			($descr,$lasttime) = split(/\:/,$value);
-		    }
-		    if ($lasttime<$since) { next; }
-		    if ($description eq '.') {
-			$qresult.=$key.'='.$descr.':'.$inst_code.'&';
-		    } else {
-			my $unescapeVal = &unescape($descr);
-			if (eval('$unescapeVal=~/\Q$description\E/i')) {
-			    $qresult.=$key.'='.$descr.':'.$inst_code.'&';
-			}
-		    }
-		}
-		if (untie(%hash)) {
-		    chop($qresult);
-		    print $client "$qresult\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting courseiddump\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting courseiddump\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
 # ----------------------------------------------------------------------- idput
-    } elsif ($userinput =~ /^idput/) {
+    if ($userinput =~ /^idput/) {
 	if(isClient) {
 	    my ($cmd,$udom,$what)=split(/:/,$userinput);
 	    chomp($what);
@@ -3849,14 +3985,14 @@
 
 # -------------------------------------------------------------- Talk to lonsql
 
-sub sqlreply {
+sub sql_reply {
     my ($cmd)=@_;
-    my $answer=subsqlreply($cmd);
-    if ($answer eq 'con_lost') { $answer=subsqlreply($cmd); }
+    my $answer=&sub_sql_reply($cmd);
+    if ($answer eq 'con_lost') { $answer=&sub_sql_reply($cmd); }
     return $answer;
 }
 
-sub subsqlreply {
+sub sub_sql_reply {
     my ($cmd)=@_;
     my $unixsock="mysqlsock";
     my $peerfile="$perlvar{'lonSockDir'}/$unixsock";
@@ -4442,7 +4578,7 @@
     return $found;
 }
 
-sub getchat {
+sub get_chat {
     my ($cdom,$cname,$udom,$uname)=@_;
     my %hash;
     my $proname=&propath($cdom,$cname);
@@ -4467,7 +4603,7 @@
     return (@participants,@entries);
 }
 
-sub chatadd {
+sub chat_add {
     my ($cdom,$cname,$newchat)=@_;
     my %hash;
     my $proname=&propath($cdom,$cname);

--foxr1093260285--