--- loncom/lond 2006/01/27 23:05:30 1.305.2.1 +++ loncom/lond 2006/01/21 08:26:52 1.306 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.305.2.1 2006/01/27 23:05:30 albertel Exp $ +# $Id: lond,v 1.306 2006/01/21 08:26:52 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,7 +59,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.305.2.1 $'; #' stupid emacs +my $VERSION='$Revision: 1.306 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -1943,7 +1943,6 @@ sub update_resource_handler { my $since=$now-$atime; if ($since>$perlvar{'lonExpire'}) { my $reply=&reply("unsub:$fname","$clientname"); - &devalidate_meta_cache($fname); unlink("$fname"); } else { my $transname="$fname.in.transfer"; @@ -1974,7 +1973,14 @@ sub update_resource_handler { alarm(0); } rename($transname,$fname); - &devalidate_meta_cache($fname); + use Cache::Memcached; + my $memcache= + new Cache::Memcached({'servers'=>['127.0.0.1:11211']}); + my $url=$fname; + $url=~s-^/home/httpd/html--; + $url=~s-\.meta$--; + my $id=&escape('meta:'.$url); + $memcache->delete($id); } } &Reply( $client, "ok\n", $userinput); @@ -1988,26 +1994,6 @@ sub update_resource_handler { } ®ister_handler("update", \&update_resource_handler, 0 ,1, 0); -sub devalidate_meta_cache { - my ($url) = @_; - use Cache::Memcached; - my $memcache = new Cache::Memcached({'servers'=>['127.0.0.1:11211']}); - $url = &declutter($url); - $url =~ s-\.meta$--; - my $id = &escape('meta:'.$url); - $memcache->delete($id); -} - -sub declutter { - my $thisfn=shift; - $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//; - $thisfn=~s/^\///; - $thisfn=~s|^adm/wrapper/||; - $thisfn=~s|^adm/coursedocs/showdoc/||; - $thisfn=~s/^res\///; - $thisfn=~s/\?.+$//; - return $thisfn; -} # # Fetch a user file from a remote server to the user's home directory # userfiles subdir. @@ -2909,22 +2895,39 @@ sub dump_with_regexp { my $userinput = "$cmd:$tail"; - my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail); + my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail); if (defined($regexp)) { $regexp=&unescape($regexp); } else { $regexp='.'; } + my ($start,$end); + if (defined($range)) { + if ($range =~/^(\d+)\-(\d+)$/) { + ($start,$end) = ($1,$2); + } elsif ($range =~/^(\d+)$/) { + ($start,$end) = (0,$1); + } else { + undef($range); + } + } my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()); if ($hashref) { my $qresult=''; + my $count=0; while (my ($key,$value) = each(%$hashref)) { if ($regexp eq '.') { + $count++; + if (defined($range) && $count >= $end) { last; } + if (defined($range) && $count < $start) { next; } $qresult.=$key.'='.$value.'&'; } else { my $unescapeKey = &unescape($key); if (eval('$unescapeKey=~/$regexp/')) { + $count++; + if (defined($range) && $count >= $end) { last; } + if (defined($range) && $count < $start) { next; } $qresult.="$key=$value&"; } }