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

[matthew]

matthew		Wed Nov 12 15:47:04 2003 EDT

  Modified files:              
    /loncom	lond 
  Log:
  Added 'inc:' command, which increments values in gdbm files.
  
  
Index: loncom/lond
diff -u loncom/lond:1.161 loncom/lond:1.162
--- loncom/lond:1.161	Tue Nov 11 07:39:14 2003
+++ loncom/lond	Wed Nov 12 15:47:04 2003
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.161 2003/11/11 12:39:14 foxr Exp $
+# $Id: lond,v 1.162 2003/11/12 20:47:04 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -52,7 +52,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.161 $'; #' stupid emacs
+my $VERSION='$Revision: 1.162 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid;
 my $currentdomainid;
@@ -1687,6 +1687,55 @@
 				foreach my $pair (@pairs) {
 				    my ($key,$value)=split(/=/,$pair);
 				    $hash{$key}=$value;
+				}
+				if (untie(%hash)) {
+				    print $client "ok\n";
+				} else {
+				    print $client "error: ".($!+0)
+					." untie(GDBM) failed ".
+					"while attempting put\n";
+				}
+			    } else {
+				print $client "error: ".($!)
+				    ." tie(GDBM) Failed ".
+				    "while attempting put\n";
+			    }
+			} else {
+			    print $client "refused\n";
+			}
+		    } else {
+			Reply($client, "refused\n", $userinput);
+
+		    }
+# ------------------------------------------------------------------- inc
+		} elsif ($userinput =~ /^inc:/) {
+		    if(isClient) {
+			my ($cmd,$udom,$uname,$namespace,$what)
+			    =split(/:/,$userinput);
+			$namespace=~s/\//\_/g;
+			$namespace=~s/\W//g;
+			if ($namespace ne 'roles') {
+			    chomp($what);
+			    my $proname=propath($udom,$uname);
+			    my $now=time;
+			    unless ($namespace=~/^nohist\_/) {
+				my $hfh;
+				if (
+				    $hfh=IO::File->new(">>$proname/$namespace.hist")
+				    ) { print $hfh "P:$now:$what\n"; }
+			    }
+			    my @pairs=split(/\&/,$what);
+			    my %hash;
+			    if (tie(%hash,'GDBM_File',
+				    "$proname/$namespace.db",
+				    &GDBM_WRCREAT(),0640)) {
+				foreach my $pair (@pairs) {
+				    my ($key,$value)=split(/=/,$pair);
+                                    # We could check that we have a number...
+                                    if (! defined($value) || $value eq '') {
+                                        $value = 1;
+                                    }
+				    $hash{$key}+=$value;
 				}
 				if (untie(%hash)) {
 				    print $client "ok\n";