--- loncom/lonnet/perl/lonnet.pm 2004/09/15 20:41:07 1.523.2.2 +++ loncom/lonnet/perl/lonnet.pm 2004/07/22 23:08:44 1.524 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.523.2.2 2004/09/15 20:41:07 albertel Exp $ +# $Id: lonnet.pm,v 1.524 2004/07/22 23:08:44 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -50,7 +50,7 @@ use Fcntl qw(:flock); use Apache::loncoursedata; use Apache::lonlocal; use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw); -use Time::HiRes qw( gettimeofday tv_interval ); +use Time::HiRes(); my $readit; =pod @@ -1047,7 +1047,6 @@ sub currentversion { sub subscribe { my $fname=shift; if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; } - $fname=~s/[\n\r]//g; my $author=$fname; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); @@ -1068,7 +1067,6 @@ sub repcopy { my $filename=shift; $filename=~s/\/+/\//g; if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; } - $filename=~s/[\n\r]//g; my $transname="$filename.in.transfer"; if ((-e $filename) || (-e $transname)) { return OK; } my $remoteurl=subscribe($filename); @@ -2593,6 +2591,30 @@ sub put { return &reply("put:$udomain:$uname:$namespace:$items",$uhome); } +# ---------------------------------------------------------- putstore interface + +sub putstore { + my ($namespace,$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.=$_.'='.&escape($$storehash{$_}).'&'; + } + foreach (keys %allitems) { + $allitems{$_} =~ s/\:$//; + $items.= $_.'='.$allitems{$_}.'&'; + } + $items=~s/\&$//; + return &reply("put:$udomain:$uname:$namespace:$items",$uhome); +} + # ------------------------------------------------------ critical put interface sub cput { @@ -3996,14 +4018,11 @@ sub EXT { my $section; if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) { - if (!$symbparm) { $symbparm=&symbread(); } - } - if ($symbparm && defined($courseid) && - $courseid eq $ENV{'request.course.id'}) { #print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest; # ----------------------------------------------------- Cascading lookup scheme + if (!$symbparm) { $symbparm=&symbread(); } my $symbp=$symbparm; my $mapp=(&decode_symb($symbp))[0]; @@ -4014,11 +4033,11 @@ sub EXT { ($ENV{'user.domain'} eq $udom)) { $section=$ENV{'request.course.sec'}; } else { - if (! defined($usection)) { - $section=&usection($udom,$uname,$courseid); - } else { - $section = $usection; - } + if (! defined($usection)) { + $section=&usection($udom,$uname,$courseid); + } else { + $section = $usection; + } } my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; @@ -4056,7 +4075,7 @@ sub EXT { $uname." at ".$udom.": ". $tmp.""); } elsif ($tmp=~/error: 2 /) { - &EXT_cache_set($udom,$uname); + &EXT_cache_set($udom,$uname); } elsif ($tmp =~ /^(con_lost|no_such_host)/) { return $tmp; } @@ -4066,10 +4085,10 @@ sub EXT { # -------------------------------------------------------- second, check course my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'}, - $ENV{'course.'.$courseid.'.domain'}, - ($seclevelr,$seclevelm,$seclevel, - $courselevelr,$courselevelm, - $courselevel)); + $ENV{'course.'.$courseid.'.domain'}, + ($seclevelr,$seclevelm,$seclevel, + $courselevelr,$courselevelm, + $courselevel)); if (defined($coursereply)) { return $coursereply; } # ------------------------------------------------------ third, check map parms @@ -4567,23 +4586,14 @@ sub deversion { sub symbread { my ($thisfn,$donotrecurse)=@_; - if (defined($ENV{'request.symbread.cached'})) { - return $ENV{'request.symbread.cached'}; - } # no filename provided? try from environment unless ($thisfn) { - if ($ENV{'request.symb'}) { - $ENV{'request.symbread.cached'}=&symbclean($ENV{'request.symb'}); - return $ENV{'request.symbread.cached'}; - } + if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); } $thisfn=$ENV{'request.filename'}; } # is that filename actually a symb? Verify, clean, and return if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) { - if (&symbverify($thisfn,$1)) { - $ENV{'request.symbread.cached'}=&symbclean($thisfn); - return $ENV{'request.symbread.cached'}; - } + if (&symbverify($thisfn,$1)) { return &symbclean($thisfn); } } $thisfn=declutter($thisfn); my %hash; @@ -4604,7 +4614,6 @@ sub symbread { unless ($syval=~/\_\d+$/) { unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { &appenv('request.ambiguous' => $thisfn); - $ENV{'request.symbread.cached'}=''; return ''; } $syval.=$1; @@ -4652,12 +4661,10 @@ sub symbread { } } if ($syval) { - $ENV{'request.symbread.cached'}=&symbclean($syval.'___'.$thisfn); - return $ENV{'request.symbread.cached'}; + return &symbclean($syval.'___'.$thisfn); } } &appenv('request.ambiguous' => $thisfn); - $ENV{'request.symbread.cached'}=''; return ''; } @@ -5935,6 +5942,17 @@ 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(). + +=item * + cput($namespace,$storehash,$udom,$uname) : critical put ($udom and $uname are optional)