--- loncom/lonnet/perl/lonnet.pm 2005/02/17 22:43:27 1.599 +++ loncom/lonnet/perl/lonnet.pm 2005/03/03 07:45:01 1.604 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.599 2005/02/17 22:43:27 albertel Exp $ +# $Id: lonnet.pm,v 1.604 2005/03/03 07:45:01 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -883,8 +883,9 @@ sub do_cache_new { $setvalue='__undef__'; } if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } - $memcache->set($id,$setvalue,300); - &make_room($id,$value,$debug); + $memcache->set($id,$setvalue,$time); + # need to make a copy of $value + #&make_room($id,$value,$debug); return $value; } @@ -910,8 +911,8 @@ sub make_room { } sub purge_remembered { - &logthis("Tossing ".scalar(keys(%remembered))); - &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered)))); + #&logthis("Tossing ".scalar(keys(%remembered))); + #&logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered)))); undef(%remembered); undef(%accessed); } @@ -993,27 +994,27 @@ sub subscribe { sub repcopy { my $filename=shift; $filename=~s/\/+/\//g; - if ($filename=~m|^/home/httpd/html/adm/|) { return OK; } - if ($filename=~m|^/home/httpd/html/lonUsers/|) { return OK; } + if ($filename=~m|^/home/httpd/html/adm/|) { return 'OK'; } + if ($filename=~m|^/home/httpd/html/lonUsers/|) { return 'OK'; } if ($filename=~m|^/home/httpd/html/userfiles/| or $filename=~m|^/*uploaded/|) { return &repcopy_userfile($filename); } $filename=~s/[\n\r]//g; my $transname="$filename.in.transfer"; - if ((-e $filename) || (-e $transname)) { return OK; } + if ((-e $filename) || (-e $transname)) { return 'OK'; } my $remoteurl=subscribe($filename); if ($remoteurl =~ /^con_lost by/) { &logthis("Subscribe returned $remoteurl: $filename"); - return HTTP_SERVICE_UNAVAILABLE; + return 'HTTP_SERVICE_UNAVAILABLE'; } elsif ($remoteurl eq 'not_found') { #&logthis("Subscribe returned not_found: $filename"); - return HTTP_NOT_FOUND; + return 'HTTP_NOT_FOUND'; } elsif ($remoteurl =~ /^rejected by/) { &logthis("Subscribe returned $remoteurl: $filename"); - return FORBIDDEN; + return 'FORBIDDEN'; } elsif ($remoteurl eq 'directory') { - return OK; + return 'OK'; } else { my $author=$filename; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; @@ -1024,7 +1025,7 @@ sub repcopy { my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; if ($path ne "$perlvar{'lonDocRoot'}/res") { &logthis("Malconfiguration for replication: $filename"); - return HTTP_BAD_REQUEST; + return 'HTTP_BAD_REQUEST'; } my $count; for ($count=5;$count<$#parts;$count++) { @@ -1041,7 +1042,7 @@ sub repcopy { my $message=$response->status_line; &logthis("WARNING:" ." LWP get: $message: $filename"); - return HTTP_SERVICE_UNAVAILABLE; + return 'HTTP_SERVICE_UNAVAILABLE'; } else { if ($remoteurl!~/\.meta$/) { my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta'); @@ -1053,7 +1054,7 @@ sub repcopy { } } rename($transname,$filename); - return OK; + return 'OK'; } } } @@ -4675,7 +4676,8 @@ sub symblist { if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', &GDBM_WRCREAT(),0640)) { foreach (keys %newhash) { - $hash{declutter($_)}=$mapname.'___'.&deversion($newhash{$_}); + $hash{declutter($_)}=&encode_symb($mapname,$newhash{$_}->[1], + $newhash{$_}->[0]); } if (untie(%hash)) { return 'ok'; @@ -4829,13 +4831,13 @@ sub symbread { } # ---------------------------------------------------------- There was an entry if ($syval) { - unless ($syval=~/\_\d+$/) { - unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { - &appenv('request.ambiguous' => $thisfn); - return $ENV{$cache_str}=''; - } - $syval.=$1; - } + #unless ($syval=~/\_\d+$/) { + #unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { + #&appenv('request.ambiguous' => $thisfn); + #return $ENV{$cache_str}=''; + #} + #$syval.=$1; + #} } else { # ------------------------------------------------------- Was not in symb table if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', @@ -4879,7 +4881,8 @@ sub symbread { } } if ($syval) { - return $ENV{$cache_str}=&symbclean($syval.'___'.$thisfn); + return $ENV{$cache_str}=$syval; + #return $ENV{$cache_str}=&symbclean($syval.'___'.$thisfn); } } &appenv('request.ambiguous' => $thisfn); @@ -5234,10 +5237,8 @@ sub getfile { sub repcopy_userfile { my ($file)=@_; - if ($file =~ m|^/*uploaded/|) { $file=&filelocation("",$file); } - if ($file =~ m|^/home/httpd/html/lonUsers/|) { return OK; } - + if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'OK'; } my ($cdom,$cnum,$filename) = ($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+([^/]+)/+([^/]+)/+(.*)|); my ($info,$rtncode); @@ -5260,7 +5261,7 @@ sub repcopy_userfile { return -1; } if ($info < $fileinfo[9]) { - return OK; + return 'OK'; } $info = ''; $lwpresp = &getuploaded('GET',$uri,$cdom,$cnum,\$info,\$rtncode); @@ -5294,7 +5295,7 @@ sub repcopy_userfile { open(FILE,">$file"); print FILE $info; close(FILE); - return OK; + return 'OK'; } sub tokenwrapper { @@ -5365,9 +5366,6 @@ sub filelocation { $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'. $udom.'/'.$uname.'/'.$filename; } - } elsif ($file =~ /^\/adm\/portfolio\//) { - $file =~ s:^/adm/portfolio/::; - $location = $location=&Apache::loncommon::propath($ENV{'user.domain'},$ENV{'user.name'}).'/userfiles/portfolio/'.$file; } else { $file=~s/^\Q$perlvar{'lonDocRoot'}\E//; $file=~s:^/res/:/:; @@ -6114,8 +6112,8 @@ subscribe($fname) : subscribe to a resou repcopy($filename) : subscribes to the requested file, and attempts to replicate from the owning library server, Might return -HTTP_SERVICE_UNAVAILABLE, HTTP_NOT_FOUND, FORBIDDEN, OK, or -HTTP_BAD_REQUEST, also attempts to grab the metadata for the +'HTTP_SERVICE_UNAVAILABLE', 'HTTP_NOT_FOUND', 'FORBIDDEN', 'OK', or +'HTTP_BAD_REQUEST', also attempts to grab the metadata for the resource. Expects the local filesystem pathname (/home/httpd/html/res/....)