[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.307 and 1.310

version 1.307, 2006/01/27 21:45:28 version 1.310, 2006/01/31 04:40:12
Line 1944  sub update_resource_handler { Line 1944  sub update_resource_handler {
     my $since=$now-$atime;      my $since=$now-$atime;
     if ($since>$perlvar{'lonExpire'}) {      if ($since>$perlvar{'lonExpire'}) {
  my $reply=&reply("unsub:$fname","$clientname");   my $reply=&reply("unsub:$fname","$clientname");
    &devalidate_meta_cache($fname);
  unlink("$fname");   unlink("$fname");
     } else {      } else {
  my $transname="$fname.in.transfer";   my $transname="$fname.in.transfer";
Line 1974  sub update_resource_handler { Line 1975  sub update_resource_handler {
  alarm(0);   alarm(0);
     }      }
     rename($transname,$fname);      rename($transname,$fname);
     use Cache::Memcached;      &devalidate_meta_cache($fname);
     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);      &Reply( $client, "ok\n", $userinput);
Line 1995  sub update_resource_handler { Line 1989  sub update_resource_handler {
 }  }
 &register_handler("update", \&update_resource_handler, 0 ,1, 0);  &register_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  #   Fetch a user file from a remote server to the user's home directory
 #   userfiles subdir.  #   userfiles subdir.
Line 3047  sub restore_handler { Line 3061  sub restore_handler {
     $namespace=~s/\//\_/g;      $namespace=~s/\//\_/g;
     $namespace=~s/\W//g;      $namespace=~s/\W//g;
     chomp($rid);      chomp($rid);
     my $proname=&propath($udom,$uname);  
     my $qresult='';      my $qresult='';
     my %hash;      my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER());
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",      if ($hashref) {
     &GDBM_READER(),0640)) {   my $version=$hashref->{"version:$rid"};
  my $version=$hash{"version:$rid"};  
  $qresult.="version=$version&";   $qresult.="version=$version&";
  my $scope;   my $scope;
  for ($scope=1;$scope<=$version;$scope++) {   for ($scope=1;$scope<=$version;$scope++) {
     my $vkeys=$hash{"$scope:keys:$rid"};      my $vkeys=$hashref->{"$scope:keys:$rid"};
     my @keys=split(/:/,$vkeys);      my @keys=split(/:/,$vkeys);
     my $key;      my $key;
     $qresult.="$scope:keys=$vkeys&";      $qresult.="$scope:keys=$vkeys&";
     foreach $key (@keys) {      foreach $key (@keys) {
  $qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";   $qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&";
     }                                        }                                  
  }   }
  if (untie(%hash)) {   if (untie(%$hashref)) {
     $qresult=~s/\&$//;      $qresult=~s/\&$//;
     &Reply( $client, "$qresult\n", $userinput);      &Reply( $client, "$qresult\n", $userinput);
  } else {   } else {
Line 5611  sub addline { Line 5623  sub addline {
   
 sub get_chat {  sub get_chat {
     my ($cdom,$cname,$udom,$uname)=@_;      my ($cdom,$cname,$udom,$uname)=@_;
     my %hash;  
     my $proname=&propath($cdom,$cname);  
     my @entries=();      my @entries=();
     if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",      my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom',
     &GDBM_READER(),0640)) {   &GDBM_READER());
  @entries=map { $_.':'.$hash{$_} } sort keys %hash;      if ($hashref) {
  untie %hash;   @entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
    untie(%$hashref);
     }      }
     my @participants=();      my @participants=();
     my $cutoff=time-60;      my $cutoff=time-60;
     if (tie(%hash,'GDBM_File',"$proname/nohist_inchatroom.db",      $hashref = &tie_user_hash($cdom, $cname, 'nohist_inchatroom',
     &GDBM_WRCREAT(),0640)) {        &GDBM_WRCREAT());
         $hash{$uname.':'.$udom}=time;      if ($hashref) {
         foreach (sort keys %hash) {          $hashref->{$uname.':'.$udom}=time;
     if ($hash{$_}>$cutoff) {          foreach my $user (sort(keys(%$hashref))) {
  $participants[$#participants+1]='active_participant:'.$_;      if ($hashref->{$user}>$cutoff) {
    push(@participants, 'active_participant:'.$user);
             }              }
         }          }
         untie %hash;          untie(%$hashref);
     }      }
     return (@participants,@entries);      return (@participants,@entries);
 }  }
   
 sub chat_add {  sub chat_add {
     my ($cdom,$cname,$newchat)=@_;      my ($cdom,$cname,$newchat)=@_;
     my %hash;  
     my $proname=&propath($cdom,$cname);  
     my @entries=();      my @entries=();
     my $time=time;      my $time=time;
     if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",      my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom',
     &GDBM_WRCREAT(),0640)) {   &GDBM_WRCREAT());
  @entries=map { $_.':'.$hash{$_} } sort keys %hash;      if ($hashref) {
    @entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
  my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);   my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
  my ($thentime,$idnum)=split(/\_/,$lastid);   my ($thentime,$idnum)=split(/\_/,$lastid);
  my $newid=$time.'_000000';   my $newid=$time.'_000000';
Line 5652  sub chat_add { Line 5664  sub chat_add {
     $idnum=substr('000000'.$idnum,-6,6);      $idnum=substr('000000'.$idnum,-6,6);
     $newid=$time.'_'.$idnum;      $newid=$time.'_'.$idnum;
  }   }
  $hash{$newid}=$newchat;   $hashref->{$newid}=$newchat;
  my $expired=$time-3600;   my $expired=$time-3600;
  foreach (keys %hash) {   foreach my $comment (keys(%$hashref)) {
     my ($thistime)=($_=~/(\d+)\_/);      my ($thistime) = ($comment=~/(\d+)\_/);
     if ($thistime<$expired) {      if ($thistime<$expired) {
  delete $hash{$_};   delete $hashref->{$comment};
     }      }
  }   }
  untie %hash;   {
     }      my $proname=&propath($cdom,$cname);
     {      if (open(CHATLOG,">>$proname/chatroom.log")) { 
  my $hfh;   print CHATLOG ("$time:".&unescape($newchat)."\n");
  if ($hfh=IO::File->new(">>$proname/chatroom.log")) {       }
     print $hfh "$time:".&unescape($newchat)."\n";      close(CHATLOG);
  }   }
    untie(%$hashref);
     }      }
 }  }
   
Removed from v.1.307  
changed lines
  Added in v.1.310

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>