Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.448 and 1.449

version 1.448, 2003/11/12 19:51:43 version 1.449, 2003/11/12 20:32:04
Line 51  use Storable qw(lock_store lock_nstore l Line 51  use Storable qw(lock_store lock_nstore l
 use Time::HiRes();  use Time::HiRes();
 my $readit;  my $readit;
   
   =pod
   
   =head1 Package Variables
   
   These are largely undocumented, so if you decipher one please note it here.
   
   =over 4
   
   =item $processmarker
   
   Contains the time this process was started and this servers host id.
   
   =item $dumpcount
   
   Counts the number of times a message log flush has been attempted (regardless
   of success) by this process.  Used as part of the filename when messages are
   delayed.
   
   =back
   
   =cut
   
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
   
 sub logtouch {  sub logtouch {
Line 1311  sub flushcourselogs { Line 1334  sub flushcourselogs {
 # File accesses  # File accesses
 # Writes to the dynamic metadata of resources to get hit counts, etc.  # Writes to the dynamic metadata of resources to get hit counts, etc.
 #  #
     foreach (keys %accesshash) {      foreach my $entry (keys(%accesshash)) {
         my $entry=$_;          my ($dom,$name,undef,$type)=($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);
         $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;  
         my %temphash=($entry => $accesshash{$entry});          my %temphash=($entry => $accesshash{$entry});
         if (&Apache::lonnet::put('nohist_resevaldata',\%temphash,$1,$2) eq 'ok') {          if ($type eq 'count'){
     delete $accesshash{$entry};              my $result = &inc('nohist_accesscount',\%temphash,$dom,$name);
               if ($result eq 'ok') {
                   delete $accesshash{$entry};
               } elsif ($result eq 'unknown_cmd') {
                   # Target server has old code running on it.
                   if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
                       delete $accesshash{$entry};
                   }
               }
    &logthis('incrementing '.$entry.' by '.$accesshash{$entry}.' result is '.$result);
           } else {
               if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
                   delete $accesshash{$entry};
               }
         }          }
     }      }
 #  #
Line 2352  sub convert_dump_to_currentdump{ Line 2387  sub convert_dump_to_currentdump{
     return \%returnhash;      return \%returnhash;
 }  }
   
   # --------------------------------------------------------------- inc interface
   
   sub inc {
       my ($namespace,$store,$udomain,$uname) = @_;
       if (!$udomain) { $udomain=$ENV{'user.domain'}; }
       if (!$uname) { $uname=$ENV{'user.name'}; }
       my $uhome=&homeserver($uname,$udomain);
       my $items='';
       if (! ref($store)) {
           # got a single value, so use that instead
           $items = &escape($store).'=&';
       } elsif (ref($store) eq 'SCALAR') {
           $items = &escape($$store).'=&';        
       } elsif (ref($store) eq 'ARRAY') {
           $items = join('=&',map {&escape($_);} @{$store});
       } elsif (ref($store) eq 'HASH') {
           while (my($key,$value) = each(%{$store})) {
               $items.= &escape($key).'='.&escape($value).'&';
           }
       }
       $items=~s/\&$//;
       return &reply("inc:$udomain:$uname:$namespace:$items",$uhome);
   }
   
 # --------------------------------------------------------------- put interface  # --------------------------------------------------------------- put interface
   
 sub put {  sub put {
Line 5210  dumps the complete (or key matching rege Line 5269  dumps the complete (or key matching rege
   
 =item *  =item *
   
   inc($namespace,$store,$udom,$uname) : increments $store in $namespace.
   $store can be a scalar, an array reference, or if the amount to be 
   incremented is > 1, a hash reference.
   
   ($udom and $uname are optional)
   
   =item *
   
 put($namespace,$storehash,$udom,$uname) : stores hash in namesp  put($namespace,$storehash,$udom,$uname) : stores hash in namesp
 ($udom and $uname are optional)  ($udom and $uname are optional)
   

Removed from v.1.448  
changed lines
  Added in v.1.449


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