[LON-CAPA-cvs] cvs: loncom / lond /lonnet/perl lonnet.pm

[albertel]

albertel		Mon May  2 19:34:43 2005 EDT

  Modified files:              
    /loncom	lond 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - newput command added to lond/lonnet
     - either adds all of a set of key value pairs to a db file or returns an error
  
  
Index: loncom/lond
diff -u loncom/lond:1.282 loncom/lond:1.283
--- loncom/lond:1.282	Mon Apr 11 20:19:59 2005
+++ loncom/lond	Mon May  2 19:34:41 2005
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.282 2005/04/12 00:19:59 raeburn Exp $
+# $Id: lond,v 1.283 2005/05/02 23:34:41 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -58,7 +58,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.282 $'; #' stupid emacs
+my $VERSION='$Revision: 1.283 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -2360,6 +2360,61 @@
 }
 &register_handler("put", \&put_user_profile_entry, 0, 1, 0);
 
+#   Put a piece of new data in hash, returns error if entry already exists
+# Parameters:
+#    $cmd      - The command that got us here.
+#    $tail     - Tail of the command (remaining parameters).
+#    $client   - File descriptor connected to client.
+# Returns
+#     0        - Requested to exit, caller should shut down.
+#     1        - Continue processing.
+#
+sub newput_user_profile_entry {
+    my ($cmd, $tail, $client)  = @_;
+
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$uname,$namespace,$what) =split(/:/,$tail,4);
+    if ($namespace eq 'roles') {
+        &Failure( $client, "refused\n", $userinput);
+	return 1;
+    }
+
+    chomp($what);
+
+    my $hashref = &tie_user_hash($udom, $uname, $namespace,
+				 &GDBM_WRCREAT(),"N",$what);
+    if(!$hashref) {
+	&Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
+		  "while attempting put\n", $userinput);
+	return 1;
+    }
+
+    my @pairs=split(/\&/,$what);
+    foreach my $pair (@pairs) {
+	my ($key,$value)=split(/=/,$pair);
+	if (exists($hashref->{$key})) {
+	    &Failure($client, "key_exists: ".$key."\n",$userinput);
+	    return 1;
+	}
+    }
+
+    foreach my $pair (@pairs) {
+	my ($key,$value)=split(/=/,$pair);
+	$hashref->{$key}=$value;
+    }
+
+    if (untie(%$hashref)) {
+	&Reply( $client, "ok\n", $userinput);
+    } else {
+	&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
+		 "while attempting put\n", 
+		 $userinput);
+    }
+    return 1;
+}
+&register_handler("newput", \&newput_user_profile_entry, 0, 1, 0);
+
 # 
 #   Increment a profile entry in the user history file.
 #   The history contains keyword value pairs.  In this case,
@@ -4480,8 +4535,6 @@
     Debug("Request was $request  Reply was $reply");
 
     $Transactions++;
-
-
 }
 
 
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.630 loncom/lonnet/perl/lonnet.pm:1.631
--- loncom/lonnet/perl/lonnet.pm:1.630	Fri Apr 29 14:38:13 2005
+++ loncom/lonnet/perl/lonnet.pm	Mon May  2 19:34:43 2005
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.630 2005/04/29 18:38:13 banghart Exp $
+# $Id: lonnet.pm,v 1.631 2005/05/02 23:34:43 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2614,8 +2614,23 @@
    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
 }
 
-# ---------------------------------------------------------- putstore interface
-                                                                                     
+# ------------------------------------------------------------ newput interface
+
+sub newput {
+   my ($namespace,$storehash,$udomain,$uname)=@_;
+   if (!$udomain) { $udomain=$env{'user.domain'}; }
+   if (!$uname) { $uname=$env{'user.name'}; }
+   my $uhome=&homeserver($uname,$udomain);
+   my $items='';
+   foreach my $key (keys(%$storehash)) {
+       $items.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
+   }
+   $items=~s/\&$//;
+   return &reply("newput:$udomain:$uname:$namespace:$items",$uhome);
+}
+
+# ---------------------------------------------------------  putstore interface
+
 sub putstore {
    my ($namespace,$storehash,$udomain,$uname)=@_;
    if (!$udomain) { $udomain=$env{'user.domain'}; }
@@ -6178,7 +6193,10 @@
 
 =item *
 
-coursedescription($courseid) : course description
+coursedescription($courseid) : returns a hash of information about the
+specified course id, including all environment settings for the
+course, the description of the course will be in the hash under the
+key 'description'
 
 =item *