[LON-CAPA-cvs] cvs: loncom / lond /interface lonfeedback.pm /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Sat, 04 Mar 2006 01:00:16 -0000
albertel Fri Mar 3 20:00:16 2006 EDT
Modified files:
/loncom/interface lonfeedback.pm
/loncom lond
/loncom/lonnet/perl lonnet.pm
Log:
- move putstore logic to lond's side of things
- changes currently don't handle newer client talking to older lond
Index: loncom/interface/lonfeedback.pm
diff -u loncom/interface/lonfeedback.pm:1.181 loncom/interface/lonfeedback.pm:1.182
--- loncom/interface/lonfeedback.pm:1.181 Thu Mar 2 13:54:49 2006
+++ loncom/interface/lonfeedback.pm Fri Mar 3 19:59:53 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Feedback
#
-# $Id: lonfeedback.pm,v 1.181 2006/03/02 18:54:49 www Exp $
+# $Id: lonfeedback.pm,v 1.182 2006/03/04 00:59:53 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2589,7 +2589,7 @@
$newcontrib{$key} = $contrib{$_};
}
my $put_reply = &Apache::lonnet::putstore($env{'request.course.id'},
- \%newcontrib,
+ $oldsymb,$oldidx,\%contrib,
$env{'course.'.$env{'request.course.id'}.'.domain'},
$env{'course.'.$env{'request.course.id'}.'.num'});
$status='Editing class discussion'.($anon?' (anonymous)':'');
Index: loncom/lond
diff -u loncom/lond:1.322 loncom/lond:1.323
--- loncom/lond:1.322 Fri Mar 3 15:06:21 2006
+++ loncom/lond Fri Mar 3 19:59:59 2006
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.322 2006/03/03 20:06:21 albertel Exp $
+# $Id: lond,v 1.323 2006/03/04 00:59:59 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,7 +61,7 @@
my $lastlog='';
my $lond_max_wait_time = 13;
-my $VERSION='$Revision: 1.322 $'; #' stupid emacs
+my $VERSION='$Revision: 1.323 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -3093,6 +3093,85 @@
}
®ister_handler("store", \&store_handler, 0, 1, 0);
+# Modify a set of key=value pairs associated with a versioned name.
+#
+# Parameters:
+# $cmd - Request command keyword.
+# $tail - Tail of the request. This is a colon
+# separated list containing:
+# domain/user - User and authentication domain.
+# namespace - Name of the database being modified
+# rid - Resource keyword to modify.
+# v - Version item to modify
+# what - new value associated with rid.
+#
+# $client - Socket open on the client.
+#
+#
+# Returns:
+# 1 (keep on processing).
+# Side-Effects:
+# Writes to the client
+sub putstore_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ my ($udom,$uname,$namespace,$rid,$v,$what) =split(/:/,$tail);
+ if ($namespace ne 'roles') {
+
+ chomp($what);
+ my $hashref = &tie_user_hash($udom, $uname, $namespace,
+ &GDBM_WRCREAT(), "M",
+ "$rid:$v:$what");
+ if ($hashref) {
+ my $now = time;
+ my %data = &hash_extract($what);
+ my @allkeys;
+ while (my($key,$value) = each(%data)) {
+ push(@allkeys,$key);
+ $hashref->{"$v:$rid:$key"} = $value;
+ }
+ my $allkeys = join(':',@allkeys);
+ $hashref->{"$v:keys:$rid"}=$allkeys;
+
+ if (&untie_user_hash($hashref)) {
+ &Reply($client, "ok\n", $userinput);
+ } else {
+ &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+ "while attempting store\n", $userinput);
+ }
+ } else {
+ &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+ "while attempting store\n", $userinput);
+ }
+ } else {
+ &Failure($client, "refused\n", $userinput);
+ }
+
+ return 1;
+}
+®ister_handler("putstore", \&putstore_handler, 0, 1, 0);
+
+sub hash_extract {
+ my ($str)=@_;
+ my %hash;
+ foreach my $pair (split(/\&/,$str)) {
+ my ($key,$value)=split(/=/,$pair);
+ $hash{$key}=$value;
+ }
+ return (%hash);
+}
+sub hash_to_str {
+ my ($hash_ref)=@_;
+ my $str;
+ foreach my $key (keys(%$hash_ref)) {
+ $str.=$key.'='.$hash_ref->{$key}.'&';
+ }
+ $str=~s/\&$//;
+ return $str;
+}
+
#
# Dump out all versions of a resource that has key=value pairs associated
# with it for each version. These resources are built up via the store
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.714 loncom/lonnet/perl/lonnet.pm:1.715
--- loncom/lonnet/perl/lonnet.pm:1.714 Fri Mar 3 18:22:18 2006
+++ loncom/lonnet/perl/lonnet.pm Fri Mar 3 20:00:15 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.714 2006/03/03 23:22:18 raeburn Exp $
+# $Id: lonnet.pm,v 1.715 2006/03/04 01:00:15 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2996,25 +2996,29 @@
# --------------------------------------------------------- putstore interface
sub putstore {
- my ($namespace,$storehash,$udomain,$uname)=@_;
+ my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_;
if (!$udomain) { $udomain=$env{'user.domain'}; }
if (!$uname) { $uname=$env{'user.name'}; }
my $uhome=&homeserver($uname,$udomain);
my $items='';
- my %allitems = ();
- foreach (keys %$storehash) {
- if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
- my $key = $1.':keys:'.$2;
- $allitems{$key} .= $3.':';
- }
- $items.=$_.'='.&freeze_escape($$storehash{$_}).'&';
- }
- foreach (keys %allitems) {
- $allitems{$_} =~ s/\:$//;
- $items.= $_.'='.$allitems{$_}.'&';
+ foreach my $key (keys(%$storehash)) {
+ $items.= &escape($key).'='.&freeze_escape($storehash->{$key}).'&';
}
$items=~s/\&$//;
- return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
+ $symb=&escape($symb);
+ $version=&escape($version);
+ my $reply =
+ &reply("putstore:$udomain:$uname:$namespace:$symb:$version:$items",
+ $uhome);
+ if ($reply eq 'unknown_cmd') {
+ return &old_putstore($namespace,$symb,$version,$storehash,$udomain,
+ $uname);
+ }
+ return $reply;
+}
+
+sub old_putstore {
+
}
# ------------------------------------------------------ critical put interface
@@ -3026,7 +3030,7 @@
my $uhome=&homeserver($uname,$udomain);
my $items='';
foreach (keys %$storehash) {
- $items.=escape($_).'='.&freeze_escape($$storehash{$_}).'&';
+ $items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
}
$items=~s/\&$//;
return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
@@ -4910,8 +4914,8 @@
# --------------------------------------------------------- Value of a Variable
sub EXT {
- my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_;
+ my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_;
unless ($varname) { return ''; }
#get real user name/domain, courseid and symb
my $courseid;