--- loncom/lonnet/perl/lonnet.pm 2006/03/03 23:22:18 1.714 +++ loncom/lonnet/perl/lonnet.pm 2006/03/04 04:25:31 1.716 @@ -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.716 2006/03/04 04:25:31 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2996,25 +2996,53 @@ sub newput { # --------------------------------------------------------- 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); + my $esc_symb=&escape($symb); + my $esc_v=&escape($version); + my $reply = + &reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items", + $uhome); + if ($reply eq 'unknown_cmd') { + # gfall back to way things use to be done + return &old_putstore($namespace,$symb,$version,$storehash,$udomain, + $uname); + } + return $reply; +} + +sub old_putstore { + 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 %newstorehash; + foreach (keys %$storehash) { + my $key = $version.':'.&escape($symb).':'.$_; + $newstorehash{$key} = $storehash->{$_}; + } + my $items=''; + my %allitems = (); + foreach (keys %newstorehash) { + if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) { + my $key = $1.':keys:'.$2; + $allitems{$key} .= $3.':'; + } + $items.=$_.'='.&freeze_escape($newstorehash{$_}).'&'; + } + foreach (keys %allitems) { + $allitems{$_} =~ s/\:$//; + $items.= $_.'='.$allitems{$_}.'&'; + } + $items=~s/\&$//; + return &reply("put:$udomain:$uname:$namespace:$items",$uhome); } # ------------------------------------------------------ critical put interface @@ -3026,7 +3054,7 @@ sub cput { 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 +4938,8 @@ sub EXT_cache_set { # --------------------------------------------------------- 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; @@ -7275,14 +7303,10 @@ put($namespace,$storehash,$udom,$uname) =item * -putstore($namespace,$storehash,$udomain,$uname) : stores hash in namesp -keys used in storehash include version information (e.g., 1:$symb:message etc.) as -used in records written by &store and retrieved by &restore. This function -was created for use in editing discussion posts, without incrementing the -version number included in the key for a particular post. The colon -separated list of attribute names (e.g., the value associated with the key -1:keys:$symb) is also generated and passed in the ampersand separated -items sent to lonnet::reply(). +putstore($namespace,$symb,$version,$storehash,$udomain,$uname) : + replaces a &store() version of data with a replacement set of data + for a particular resource in a namespace passed in the $storehash hash + reference =item *