--- loncom/lonnet/perl/lonnet.pm	2003/11/12 19:51:43	1.448
+++ loncom/lonnet/perl/lonnet.pm	2003/12/04 20:09:35	1.452
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.448 2003/11/12 19:51:43 albertel Exp $
+# $Id: lonnet.pm,v 1.452 2003/12/04 20:09:35 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -51,6 +51,29 @@ use Storable qw(lock_store lock_nstore l
 use Time::HiRes();
 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
 
 sub logtouch {
@@ -825,10 +848,14 @@ sub getsection {
     return '-1';
 }
 
+
+my $disk_caching_disabled=1;
+
 sub devalidate_cache {
     my ($cache,$id,$name) = @_;
     delete $$cache{$id.'.time'};
     delete $$cache{$id};
+    if ($disk_caching_disabled) { return; }
     my $filename=$perlvar{'lonDaemons'}.'/tmp/lonnet_internal_cache_'.$name.".db";
     open(DB,"$filename.lock");
     flock(DB,LOCK_EX);
@@ -884,6 +911,7 @@ sub do_cache {
 
 sub save_cache_item {
     my ($cache,$name,$id)=@_;
+    if ($disk_caching_disabled) { return; }
     my $starttime=&Time::HiRes::time();
 #    &logthis("Saving :$name:$id");
     my %hash;
@@ -913,6 +941,7 @@ EVALBLOCK
 
 sub load_cache_item {
     my ($cache,$name,$id)=@_;
+    if ($disk_caching_disabled) { return; }
     my $starttime=&Time::HiRes::time();
 #    &logthis("Before Loading $name  for $id size is ".scalar(%$cache));
     my %hash;
@@ -1130,8 +1159,8 @@ sub ssi_body {
     my ($filelink,%form)=@_;
     my $output=($filelink=~/^http\:/?&externalssi($filelink):
                                      &ssi($filelink,%form));
-    $output=~s/^.*\<body[^\>]*\>//si;
-    $output=~s/\<\/body\s*\>.*$//si;
+    $output=~s/^.*?\<body[^\>]*\>//si;
+    $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;
     $output=~
             s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;
     return $output;
@@ -1311,12 +1340,27 @@ sub flushcourselogs {
 # File accesses
 # Writes to the dynamic metadata of resources to get hit counts, etc.
 #
-    foreach (keys %accesshash) {
-        my $entry=$_;
-        $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;
-        my %temphash=($entry => $accesshash{$entry});
-        if (&Apache::lonnet::put('nohist_resevaldata',\%temphash,$1,$2) eq 'ok') {
-	    delete $accesshash{$entry};
+    foreach my $entry (keys(%accesshash)) {
+        my ($dom,$name,undef,$type)=($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);
+        if ($type eq 'count'){
+            my $value = $accesshash{$entry};
+            my (undef,$url,undef) = ($entry =~ /^(.*)___(.*)___count$/);
+            my %temphash=($url => $value);
+            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.
+                my %temphash=($entry => $value);
+                if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
+                    delete $accesshash{$entry};
+                }
+            }
+        } else {
+            my %temphash=($entry => $accesshash{$entry});
+            if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
+                delete $accesshash{$entry};
+            }
         }
     }
 #
@@ -1353,7 +1397,8 @@ sub courselog {
     } else {
 	$courselogs{$ENV{'request.course.id'}}.=$what;
     }
-    if (length($courselogs{$ENV{'request.course.id'}})>4048) {
+#    if (length($courselogs{$ENV{'request.course.id'}})>4048) {
+    if (length($courselogs{$ENV{'request.course.id'}})>48) {
 	&flushcourselogs();
     }
 }
@@ -1378,11 +1423,7 @@ sub countacc {
     unless ($ENV{'request.course.id'}) { return ''; }
     $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;
     my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';
-    if (defined($accesshash{$key})) {
-	$accesshash{$key}++;
-    } else {
-        $accesshash{$key}=1;
-    }
+    $accesshash{$key}++;
 }
 
 sub linklog {
@@ -2352,6 +2393,30 @@ sub convert_dump_to_currentdump{
     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
 
 sub put {
@@ -5210,6 +5275,14 @@ dumps the complete (or key matching rege
 
 =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
 ($udom and $uname are optional)